library(dplyr)
library(kableExtra)
library(ggplot2)
library(knitr)
library(corrplot)
library(FactoMineR)
library(ggdendro)
library(GGally)
library(caret)
library(splines)
library(tidyr)

options(knitr.table.format = "html")

#Funciones para los graficos
give.n <- function(x,n){
  return(c(y = mean(x)*1.5, label = length(x)))
}
give1.n<-function(x,n){
  return(c(y = mean(x)*1.5, label = length(x)))
}

my_rg1 <- function(data, mapping, ...){
  
  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() +
    geom_smooth(method='loess', fill="red", color="red",se=FALSE) +
    geom_smooth(method='lm', fill="cyan", color="cyan",se=FALSE) 
    
  p
  
}
my_rg2 <- function(data, mapping, ...){
  
  p <- ggplot(data = data,mapping=mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',formula=y~splines::bs(x),fill='darkorchid3',color='darkorchid3',se=FALSE) +
    
    geom_smooth(method='lm',formula=y~poly(x),fill='orangered',color='orangered',se=FALSE)
  
  p
  
}
my_rg3 <- function(data, mapping, ...){
 
  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',formula=y~splines::bs(x),fill='darkgreen',color='darkgreen',alpha=.1) +
    
    geom_smooth(method='loess', fill="firebrick1", color="firebrick1",alpha=.1)
  
  p
  
}
#Solo para las discretas
my_rg4 <- function(data, mapping, ...){

  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',fill='purple',color='purple',alpha=.3)
  
  p
  
}

#Funcion para regresion
normalize <- function(x) {
  return ((x - min(x)) / (max(x) - min(x))) }

1 PREPARACION



1.1 ESTRUCTURA DE LOS DATOS

Tenemos un archivo de entrenamiento para realizar un aprendizaje supervisado formado por 1460 casos con 81 variables.

Una de ellas es nuestro objetivo SalePrice, y debemos ser capaces de predecir esa variable con el dataframe Test que se nos proporciona, que es de 1459 casos.

Otra variable importante es la primera, Id que nos identifica de manera única cada registro.

En el dataframe Train tenemos los 1460 primeros.

En el dataframe Test tenemos desde el 1461 hasta el 2919

Tenemos varios tipos de variables, como se vera en el siguiente epígrafe, además de las cuales cambiaremos los tipos de algunas.

Hay que realizar una limpieza y control exhaustiva de todos los datos, haciendo énfasis en los valores NA

Para realizar una preparación adecuada y buscar un modelo hay que unir los dos dataframe creando los datos que nos faltan en Test (SalePrice la variable objetivo ) y poniendo como valor NA

url_test="https://www.kaggle.com/c/house-prices-advanced-regression-techniques/download/test.csv"
url_train="https://www.kaggle.com/c/house-prices-advanced-regression-techniques/download/train.csv"

train<-read.csv("train.csv",sep = ",", header=TRUE,stringsAsFactors = FALSE)
test<-read.csv("test.csv",sep=",",header=TRUE,stringsAsFactors = FALSE)
summary(train)
##        Id           MSSubClass      MSZoning          LotFrontage    
##  Min.   :   1.0   Min.   : 20.0   Length:1460        Min.   : 21.00  
##  1st Qu.: 365.8   1st Qu.: 20.0   Class :character   1st Qu.: 59.00  
##  Median : 730.5   Median : 50.0   Mode  :character   Median : 69.00  
##  Mean   : 730.5   Mean   : 56.9                      Mean   : 70.05  
##  3rd Qu.:1095.2   3rd Qu.: 70.0                      3rd Qu.: 80.00  
##  Max.   :1460.0   Max.   :190.0                      Max.   :313.00  
##                                                      NA's   :259     
##     LotArea          Street             Alley             LotShape        
##  Min.   :  1300   Length:1460        Length:1460        Length:1460       
##  1st Qu.:  7554   Class :character   Class :character   Class :character  
##  Median :  9478   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 10517                                                           
##  3rd Qu.: 11602                                                           
##  Max.   :215245                                                           
##                                                                           
##  LandContour         Utilities          LotConfig        
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##   LandSlope         Neighborhood        Condition1       
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##   Condition2          BldgType          HouseStyle         OverallQual    
##  Length:1460        Length:1460        Length:1460        Min.   : 1.000  
##  Class :character   Class :character   Class :character   1st Qu.: 5.000  
##  Mode  :character   Mode  :character   Mode  :character   Median : 6.000  
##                                                           Mean   : 6.099  
##                                                           3rd Qu.: 7.000  
##                                                           Max.   :10.000  
##                                                                           
##   OverallCond      YearBuilt     YearRemodAdd   RoofStyle        
##  Min.   :1.000   Min.   :1872   Min.   :1950   Length:1460       
##  1st Qu.:5.000   1st Qu.:1954   1st Qu.:1967   Class :character  
##  Median :5.000   Median :1973   Median :1994   Mode  :character  
##  Mean   :5.575   Mean   :1971   Mean   :1985                     
##  3rd Qu.:6.000   3rd Qu.:2000   3rd Qu.:2004                     
##  Max.   :9.000   Max.   :2010   Max.   :2010                     
##                                                                  
##    RoofMatl         Exterior1st        Exterior2nd       
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##   MasVnrType          MasVnrArea      ExterQual          ExterCond        
##  Length:1460        Min.   :   0.0   Length:1460        Length:1460       
##  Class :character   1st Qu.:   0.0   Class :character   Class :character  
##  Mode  :character   Median :   0.0   Mode  :character   Mode  :character  
##                     Mean   : 103.7                                        
##                     3rd Qu.: 166.0                                        
##                     Max.   :1600.0                                        
##                     NA's   :8                                             
##   Foundation          BsmtQual           BsmtCond        
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##  BsmtExposure       BsmtFinType1         BsmtFinSF1     BsmtFinType2      
##  Length:1460        Length:1460        Min.   :   0.0   Length:1460       
##  Class :character   Class :character   1st Qu.:   0.0   Class :character  
##  Mode  :character   Mode  :character   Median : 383.5   Mode  :character  
##                                        Mean   : 443.6                     
##                                        3rd Qu.: 712.2                     
##                                        Max.   :5644.0                     
##                                                                           
##    BsmtFinSF2        BsmtUnfSF       TotalBsmtSF       Heating         
##  Min.   :   0.00   Min.   :   0.0   Min.   :   0.0   Length:1460       
##  1st Qu.:   0.00   1st Qu.: 223.0   1st Qu.: 795.8   Class :character  
##  Median :   0.00   Median : 477.5   Median : 991.5   Mode  :character  
##  Mean   :  46.55   Mean   : 567.2   Mean   :1057.4                     
##  3rd Qu.:   0.00   3rd Qu.: 808.0   3rd Qu.:1298.2                     
##  Max.   :1474.00   Max.   :2336.0   Max.   :6110.0                     
##                                                                        
##   HeatingQC          CentralAir         Electrical          X1stFlrSF   
##  Length:1460        Length:1460        Length:1460        Min.   : 334  
##  Class :character   Class :character   Class :character   1st Qu.: 882  
##  Mode  :character   Mode  :character   Mode  :character   Median :1087  
##                                                           Mean   :1163  
##                                                           3rd Qu.:1391  
##                                                           Max.   :4692  
##                                                                         
##    X2ndFlrSF     LowQualFinSF       GrLivArea     BsmtFullBath   
##  Min.   :   0   Min.   :  0.000   Min.   : 334   Min.   :0.0000  
##  1st Qu.:   0   1st Qu.:  0.000   1st Qu.:1130   1st Qu.:0.0000  
##  Median :   0   Median :  0.000   Median :1464   Median :0.0000  
##  Mean   : 347   Mean   :  5.845   Mean   :1515   Mean   :0.4253  
##  3rd Qu.: 728   3rd Qu.:  0.000   3rd Qu.:1777   3rd Qu.:1.0000  
##  Max.   :2065   Max.   :572.000   Max.   :5642   Max.   :3.0000  
##                                                                  
##   BsmtHalfBath        FullBath        HalfBath       BedroomAbvGr  
##  Min.   :0.00000   Min.   :0.000   Min.   :0.0000   Min.   :0.000  
##  1st Qu.:0.00000   1st Qu.:1.000   1st Qu.:0.0000   1st Qu.:2.000  
##  Median :0.00000   Median :2.000   Median :0.0000   Median :3.000  
##  Mean   :0.05753   Mean   :1.565   Mean   :0.3829   Mean   :2.866  
##  3rd Qu.:0.00000   3rd Qu.:2.000   3rd Qu.:1.0000   3rd Qu.:3.000  
##  Max.   :2.00000   Max.   :3.000   Max.   :2.0000   Max.   :8.000  
##                                                                    
##   KitchenAbvGr   KitchenQual         TotRmsAbvGrd     Functional       
##  Min.   :0.000   Length:1460        Min.   : 2.000   Length:1460       
##  1st Qu.:1.000   Class :character   1st Qu.: 5.000   Class :character  
##  Median :1.000   Mode  :character   Median : 6.000   Mode  :character  
##  Mean   :1.047                      Mean   : 6.518                     
##  3rd Qu.:1.000                      3rd Qu.: 7.000                     
##  Max.   :3.000                      Max.   :14.000                     
##                                                                        
##    Fireplaces    FireplaceQu         GarageType         GarageYrBlt  
##  Min.   :0.000   Length:1460        Length:1460        Min.   :1900  
##  1st Qu.:0.000   Class :character   Class :character   1st Qu.:1961  
##  Median :1.000   Mode  :character   Mode  :character   Median :1980  
##  Mean   :0.613                                         Mean   :1979  
##  3rd Qu.:1.000                                         3rd Qu.:2002  
##  Max.   :3.000                                         Max.   :2010  
##                                                        NA's   :81    
##  GarageFinish         GarageCars      GarageArea      GarageQual       
##  Length:1460        Min.   :0.000   Min.   :   0.0   Length:1460       
##  Class :character   1st Qu.:1.000   1st Qu.: 334.5   Class :character  
##  Mode  :character   Median :2.000   Median : 480.0   Mode  :character  
##                     Mean   :1.767   Mean   : 473.0                     
##                     3rd Qu.:2.000   3rd Qu.: 576.0                     
##                     Max.   :4.000   Max.   :1418.0                     
##                                                                        
##   GarageCond         PavedDrive          WoodDeckSF      OpenPorchSF    
##  Length:1460        Length:1460        Min.   :  0.00   Min.   :  0.00  
##  Class :character   Class :character   1st Qu.:  0.00   1st Qu.:  0.00  
##  Mode  :character   Mode  :character   Median :  0.00   Median : 25.00  
##                                        Mean   : 94.24   Mean   : 46.66  
##                                        3rd Qu.:168.00   3rd Qu.: 68.00  
##                                        Max.   :857.00   Max.   :547.00  
##                                                                         
##  EnclosedPorch      X3SsnPorch      ScreenPorch        PoolArea      
##  Min.   :  0.00   Min.   :  0.00   Min.   :  0.00   Min.   :  0.000  
##  1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.000  
##  Median :  0.00   Median :  0.00   Median :  0.00   Median :  0.000  
##  Mean   : 21.95   Mean   :  3.41   Mean   : 15.06   Mean   :  2.759  
##  3rd Qu.:  0.00   3rd Qu.:  0.00   3rd Qu.:  0.00   3rd Qu.:  0.000  
##  Max.   :552.00   Max.   :508.00   Max.   :480.00   Max.   :738.000  
##                                                                      
##     PoolQC             Fence           MiscFeature       
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##     MiscVal             MoSold           YrSold       SaleType        
##  Min.   :    0.00   Min.   : 1.000   Min.   :2006   Length:1460       
##  1st Qu.:    0.00   1st Qu.: 5.000   1st Qu.:2007   Class :character  
##  Median :    0.00   Median : 6.000   Median :2008   Mode  :character  
##  Mean   :   43.49   Mean   : 6.322   Mean   :2008                     
##  3rd Qu.:    0.00   3rd Qu.: 8.000   3rd Qu.:2009                     
##  Max.   :15500.00   Max.   :12.000   Max.   :2010                     
##                                                                       
##  SaleCondition        SalePrice     
##  Length:1460        Min.   : 34900  
##  Class :character   1st Qu.:129975  
##  Mode  :character   Median :163000  
##                     Mean   :180921  
##                     3rd Qu.:214000  
##                     Max.   :755000  
## 
str(train)
## 'data.frame':    1460 obs. of  81 variables:
##  $ Id           : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ MSSubClass   : int  60 20 60 70 60 50 20 60 50 190 ...
##  $ MSZoning     : chr  "RL" "RL" "RL" "RL" ...
##  $ LotFrontage  : int  65 80 68 60 84 85 75 NA 51 50 ...
##  $ LotArea      : int  8450 9600 11250 9550 14260 14115 10084 10382 6120 7420 ...
##  $ Street       : chr  "Pave" "Pave" "Pave" "Pave" ...
##  $ Alley        : chr  NA NA NA NA ...
##  $ LotShape     : chr  "Reg" "Reg" "IR1" "IR1" ...
##  $ LandContour  : chr  "Lvl" "Lvl" "Lvl" "Lvl" ...
##  $ Utilities    : chr  "AllPub" "AllPub" "AllPub" "AllPub" ...
##  $ LotConfig    : chr  "Inside" "FR2" "Inside" "Corner" ...
##  $ LandSlope    : chr  "Gtl" "Gtl" "Gtl" "Gtl" ...
##  $ Neighborhood : chr  "CollgCr" "Veenker" "CollgCr" "Crawfor" ...
##  $ Condition1   : chr  "Norm" "Feedr" "Norm" "Norm" ...
##  $ Condition2   : chr  "Norm" "Norm" "Norm" "Norm" ...
##  $ BldgType     : chr  "1Fam" "1Fam" "1Fam" "1Fam" ...
##  $ HouseStyle   : chr  "2Story" "1Story" "2Story" "2Story" ...
##  $ OverallQual  : int  7 6 7 7 8 5 8 7 7 5 ...
##  $ OverallCond  : int  5 8 5 5 5 5 5 6 5 6 ...
##  $ YearBuilt    : int  2003 1976 2001 1915 2000 1993 2004 1973 1931 1939 ...
##  $ YearRemodAdd : int  2003 1976 2002 1970 2000 1995 2005 1973 1950 1950 ...
##  $ RoofStyle    : chr  "Gable" "Gable" "Gable" "Gable" ...
##  $ RoofMatl     : chr  "CompShg" "CompShg" "CompShg" "CompShg" ...
##  $ Exterior1st  : chr  "VinylSd" "MetalSd" "VinylSd" "Wd Sdng" ...
##  $ Exterior2nd  : chr  "VinylSd" "MetalSd" "VinylSd" "Wd Shng" ...
##  $ MasVnrType   : chr  "BrkFace" "None" "BrkFace" "None" ...
##  $ MasVnrArea   : int  196 0 162 0 350 0 186 240 0 0 ...
##  $ ExterQual    : chr  "Gd" "TA" "Gd" "TA" ...
##  $ ExterCond    : chr  "TA" "TA" "TA" "TA" ...
##  $ Foundation   : chr  "PConc" "CBlock" "PConc" "BrkTil" ...
##  $ BsmtQual     : chr  "Gd" "Gd" "Gd" "TA" ...
##  $ BsmtCond     : chr  "TA" "TA" "TA" "Gd" ...
##  $ BsmtExposure : chr  "No" "Gd" "Mn" "No" ...
##  $ BsmtFinType1 : chr  "GLQ" "ALQ" "GLQ" "ALQ" ...
##  $ BsmtFinSF1   : int  706 978 486 216 655 732 1369 859 0 851 ...
##  $ BsmtFinType2 : chr  "Unf" "Unf" "Unf" "Unf" ...
##  $ BsmtFinSF2   : int  0 0 0 0 0 0 0 32 0 0 ...
##  $ BsmtUnfSF    : int  150 284 434 540 490 64 317 216 952 140 ...
##  $ TotalBsmtSF  : int  856 1262 920 756 1145 796 1686 1107 952 991 ...
##  $ Heating      : chr  "GasA" "GasA" "GasA" "GasA" ...
##  $ HeatingQC    : chr  "Ex" "Ex" "Ex" "Gd" ...
##  $ CentralAir   : chr  "Y" "Y" "Y" "Y" ...
##  $ Electrical   : chr  "SBrkr" "SBrkr" "SBrkr" "SBrkr" ...
##  $ X1stFlrSF    : int  856 1262 920 961 1145 796 1694 1107 1022 1077 ...
##  $ X2ndFlrSF    : int  854 0 866 756 1053 566 0 983 752 0 ...
##  $ LowQualFinSF : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ GrLivArea    : int  1710 1262 1786 1717 2198 1362 1694 2090 1774 1077 ...
##  $ BsmtFullBath : int  1 0 1 1 1 1 1 1 0 1 ...
##  $ BsmtHalfBath : int  0 1 0 0 0 0 0 0 0 0 ...
##  $ FullBath     : int  2 2 2 1 2 1 2 2 2 1 ...
##  $ HalfBath     : int  1 0 1 0 1 1 0 1 0 0 ...
##  $ BedroomAbvGr : int  3 3 3 3 4 1 3 3 2 2 ...
##  $ KitchenAbvGr : int  1 1 1 1 1 1 1 1 2 2 ...
##  $ KitchenQual  : chr  "Gd" "TA" "Gd" "Gd" ...
##  $ TotRmsAbvGrd : int  8 6 6 7 9 5 7 7 8 5 ...
##  $ Functional   : chr  "Typ" "Typ" "Typ" "Typ" ...
##  $ Fireplaces   : int  0 1 1 1 1 0 1 2 2 2 ...
##  $ FireplaceQu  : chr  NA "TA" "TA" "Gd" ...
##  $ GarageType   : chr  "Attchd" "Attchd" "Attchd" "Detchd" ...
##  $ GarageYrBlt  : int  2003 1976 2001 1998 2000 1993 2004 1973 1931 1939 ...
##  $ GarageFinish : chr  "RFn" "RFn" "RFn" "Unf" ...
##  $ GarageCars   : int  2 2 2 3 3 2 2 2 2 1 ...
##  $ GarageArea   : int  548 460 608 642 836 480 636 484 468 205 ...
##  $ GarageQual   : chr  "TA" "TA" "TA" "TA" ...
##  $ GarageCond   : chr  "TA" "TA" "TA" "TA" ...
##  $ PavedDrive   : chr  "Y" "Y" "Y" "Y" ...
##  $ WoodDeckSF   : int  0 298 0 0 192 40 255 235 90 0 ...
##  $ OpenPorchSF  : int  61 0 42 35 84 30 57 204 0 4 ...
##  $ EnclosedPorch: int  0 0 0 272 0 0 0 228 205 0 ...
##  $ X3SsnPorch   : int  0 0 0 0 0 320 0 0 0 0 ...
##  $ ScreenPorch  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ PoolArea     : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ PoolQC       : chr  NA NA NA NA ...
##  $ Fence        : chr  NA NA NA NA ...
##  $ MiscFeature  : chr  NA NA NA NA ...
##  $ MiscVal      : int  0 0 0 0 0 700 0 350 0 0 ...
##  $ MoSold       : int  2 5 9 2 12 10 8 11 4 1 ...
##  $ YrSold       : int  2008 2007 2008 2006 2008 2009 2007 2009 2008 2008 ...
##  $ SaleType     : chr  "WD" "WD" "WD" "WD" ...
##  $ SaleCondition: chr  "Normal" "Normal" "Normal" "Abnorml" ...
##  $ SalePrice    : int  208500 181500 223500 140000 250000 143000 307000 200000 129900 118000 ...
dim(train)
## [1] 1460   81
AuxTrain<-train
AuxTest<-test
AuxTest$SalePrice<-NA
total<-rbind(AuxTrain,AuxTest)

1.2 VARIABLES

Vamos , en primer lugar, a hacer un estudio de las variables proporcionadas. Tenemos tres tipos :

  • Variables cuantificables
  • Variables categóricas .
  • Variables categóricas ya cuantificadas

1.2.1 VARIABLES CUANTIFICADAS (integer)

Codigo Significado
ID Identidad
LotFrontage pies lineales de la calle conectados a la propiedad
LotArea Tamaño del lote en pies cuadrados
YearBuilt fecha de construcción original
YearRemodAdd fecha de remodelación
MasVnrArea área de chapa de la albañilería en pies cuadrados
BsmtFinSF1 Tipo 1 pies cuadrados terminados
BsmtFinSF2 Tipo 2 pies cuadrados terminados
BsmtUnfSF Pies cuadrados sin terminar del área del sótano
TotalBsmtSF pies cuadrados totales del área del sótano
1stFlrSF primer piso pies cuadrados
2ndFlrSF segundo piso pies cuadrados
LowQualFinSF Pies cuadrados terminados de baja calidad (todos los pisos)
GrLivArea pies cuadrados del área habitable sobre el nivel del suelo
BsmtFullBath baños completos en el sótano
BsmtHalfBath medio baño en el sótano
FullBath baños completos por encima del grado
HalfBath medio baño por encima del grado
Bedroom Número de habitaciones sobre el nivel del sótano
Kitchen Número de cocinas
TotRmsAbvGrd Total de habitaciones por encima del grado (no incluye baños)
Fireplaces cantidad de chimeneas
GarageYrBlt año de garaje fue construido
GarageCars tamaño del garaje en la capacidad del automóvil
GarageArea Tamaño del garaje en pies cuadrados
WoodDeckSF área de cubierta de madera en pies cuadrados
OpenPorchSF área de porche abierto en pies cuadrados
EnclosedPorch área de porche cerrado en pies cuadrados
3SsnPorch área del porche de tres estaciones en pies cuadrados
ScreenPorch área del porche de la pantalla en pies cuadrados
PoolArea área de la piscina en pies cuadrados
MiscVal $ Valor de la función miscelánea
MoSold Mes vendido
YrSold Año de venta
SalePrice el precio de venta de la propiedad en dólares.

1.2.2 VARIABLES CATEGORICAS (Caracter)

MSZoning
la clasificación general de zonificación

Codigo Tipo
A Agriculture
C Commercial
FV Floating Village Residential
I Industrial
RH Residential High Density
RL Residential Low Density
RP Residential Low Density Park
RM Residential Medium Density

Street
Tipo de acceso por carretera

Codigo Tipo
Grvl Gravel
Pave Paved

Alley
tipo de acceso a callejones

Codigo Tipo
Grvl Gravel
Pave Paved
NA No alley access

LotShape
forma general de la propiedad

Codigo Tipo
Reg Regular
IR1 Slightly irregular
IR2 Moderately Irregular
IR3 Irregular

LandContour
planitud de la propiedad

Codigo Tipo
Lvl Near Flat/Level
Bnk Banked - Quick and significant rise from street grade to building
HLS Hillside - Significant slope from side to side
Low Depression

Utilities
Tipo de utilidades disponibles

Codigo Tipo
AllPub All public Utilities (E,G,W,& S)
NoSewr Electricity, Gas, and Water (Septic Tank)
NoSewa Electricity and Gas Only
ELO Electricity only

LotConfig
configuración del lote

Codigo Tipo
Inside Inside lot
Corner Corner lot
CulDSac Cul-de-sac
FR2 Frontage on 2 sides of property
FR3 Frontage on 3 sides of property

LandSlope
Pendiente de la propiedad

Codigo Tipo
Gtl Gentle slope
Mod Moderate Slope
Sev Severe Slope

Neighborhood
ubicaciones físicas dentro de los límites de la ciudad de Ames

Codigo Tipo
Blmngtn Bloomington Heights
Blueste Bluestem
BrDale Briardale
BrkSide Brookside
ClearCr Clear Creek
CollgCr College Creek
Crawfor Crawford
Edwards Edwards
Gilbert Gilbert
IDOTRR Iowa DOT and Rail Road
MeadowV Meadow Village
Mitchel Mitchell
NAmes North Ames
NoRidge Northridge
NPkVill Northpark Villa
NridgHt Northridge Heights
NWAmes Northwest Ames
OldTown Old Town
SWISU South & West of Iowa State University
Sawyer Sawyer
SawyerW Sawyer West
Somerst Somerset
StoneBr Stone Brook
Timber Timberland
Veenker Veenker

Condition1
proximidad a la carretera principal o ferrocarril

Codigo Tipo
Artery Adjacent to arterial street
Feedr Adjacent to feeder street
Norm Normal
PosA Adjacent to postive off-site feature
PosN Near positive off-site feature–park, greenbelt, etc.
RRAe Adjacent to East-West Railroad
RRAn Adjacent to North-South Railroad
RRNe Within 200’ of East-West Railroad
RRNn Within 200’ of North-South Railroad

Condition2
proximidad a la carretera principal o ferrocarril (si hay un segundo presente)

Codigo Tipo
Artery Adjacent to arterial street
Feedr Adjacent to feeder street
Norm Normal
PosA Adjacent to postive off-site feature
PosN Near positive off-site feature–park, greenbelt, etc.
RRAe Adjacent to East-West Railroad
RRAn Adjacent to North-South Railroad
RRNe Within 200’ of East-West Railroad
RRNn Within 200’ of North-South Railroad

BldgType
tipo de vivienda

Codigo Tipo
1Fam Single-family Detached
2fmCon Two-family Conversion; originally built as one-family dwelling
Duplex Duplex
TwnhsE Townhouse End Unit
Twnhs I Townhouse Inside Unit

HouseStyle
estilo de vivienda

Codigo Tipo
1.5Fin One and one-half story: 2nd level finished
1.5Unf One and one-half story: 2nd level unfinished
1Story One story
2.5Fin Two and one-half story: 2nd level finished
2.5Unf Two and one-half story: 2nd level unfinished
2Story Two story
SFoyer Split Foyer
SLvl Split Level

RoofStyle
tipo de techo

Codigo Tipo
Flat Flat
Gable Gable
Gambrel Gabrel (Barn)
Hip Hip
Mansard Mansard
Shed Shed

RoofMatl
material de techo

Codigo Tipo
ClyTile Clay or Tile
CompShg Standard (Composite) Shingle
Membran Membrane
Metal Metal
Roll Roll
Tar&Grv Gravel & Tar
WdShake Wood Shakes
WdShngl Wood Shingles

Exterior1st
revestimiento exterior en la casa

Codigo Tipo
AsbShng Asbestos Shingles
AsphShn Asphalt Shingles
BrkComm Brick Common
BrkFace Brick Face
CBlock Cinder Block
CemntBd Cement Board
HdBoard Hard Board
ImStucc Imitation Stucco
MetalSd Metal Siding
Other Other
Plywood Plywood
PreCast PreCast
Stone Stone
Stucco Stucco
VinylSd Vinyl Siding
Wd Sdng Wood Siding
WdShing Wood Shingles

Exterior2nd
Cubierta exterior en la casa (si hay más de un material)

Codigo Tipo
AsbShng Asbestos Shingles
AsphShn Asphalt Shingles
Brk Cmn Brick Common
BrkFace Brick Face
CBlock Cinder Block
CmentBd Cement Board
HdBoard Hard Board
ImStucc Imitation Stucco
MetalSd Metal Siding
Other Other
Plywood Plywood
PreCast PreCast
Stone Stone
Stucco Stucco
VinylSd Vinyl Siding
Wd Sdng Wood Siding
Wd Shng Wood Shingles

MasVnrType
Tipo de chapa de mampostería

Codigo Tipo
BrkCmn Brick Common
BrkFace Brick Face
Cblock Cinder Block
None None
Stone Stone

ExterQual
calidad del material exterior

Codigo Tipo
Ex Excellent
Fa Fair
Gd Good
TA Average/Typical
Po Poor

ExterCond
estado actual del material en el exterior

Codigo Tipo
Ex Excellent
Fa Fair
Gd Good
Po Poor
TA Average/Typical

Foundation
tipo de fundación

Codigo Tipo
BrkTil Brick & Tile
CBlock Cinder Block
PConc Poured Contrete
Slab Slab
Stone Stone
Wood Wood

BsmtQual
Altura del sótano

Codigo Tipo
Ex Excellent (100+ inches)
Fa Fair (70-79 inches)
Gd Good (90-99 inches)
NA No Basement
Po Poor (<70 inches
TA Typical (80-89 inches)

BsmtCond
estado general del sótano

Codigo Tipo
Ex Excellent
Fa Fair - dampness or some cracking or settling
Gd Good
NA No Basement
Po Poor - Severe cracking, settling, or wetness
TA Typical - slight dampness allowed

BsmtExposure
muros de sotano a ras de suelo o de jardín

Codigo Tipo
Av Average Exposure (split levels or foyers typically score average or above)
Gd Good Exposure
Mn Mimimum Exposure
NA No Basement
No No Exposure

BsmtFinType1
Calidad del área acabada del sótano

Codigo Tipo
ALQ Average Living Quarters
BLQ Below Average Living Quarters
GLQ Good Living Quarters
LwQ Low Quality
NA No Basement
Rec Average Rec Room
Unf Unfinshed

BsmtFinType2
Calidad del segundo área terminada (si está presente)

Codigo Tipo
ALQ Average Living Quarters
BLQ Below Average Living Quarters
GLQ Good Living Quarters
LwQ Low Quality
NA No Basement
Rec Average Rec Room
Unf Unfinshed

Heating
tipo de calefacción

Codigo Tipo
Floor Floor Furnace
GasA Gas forced warm air furnace
GasW Gas hot water or steam heat
Grav Gravity furnace
OthW Hot water or steam heat other than gas
Wall Wall furnace

HeatingQC
Calidad y condición de la calefacción

Codigo Tipo
Ex Excellent
Fa Fair
Gd Good
Po Poor
TA Average/Typical

CentralAir
Aire acondicionado central

Codigo Tipo
N No
Y Yes

Electrical
sistema eléctrico

Codigo Tipo
FuseA Fuse Box over 60 AMP and all Romex wiring (Average)
FuseF 60 AMP Fuse Box and mostly Romex wiring (Fair)
FuseP 60 AMP Fuse Box and mostly knob & tube wiring (poor)
Mix Mixed
SBrkr Standard Circuit Breakers & Romex

KitchenQual
calidad de la cocina

Codigo Tipo
Ex Excellent
Fa Fair
Gd Good
Po Poor
TA Typical/Average

Functional
calificación de la funcionalidad del hogar

Codigo Tipo
Maj1 Major Deductions 1
Maj2 Major Deductions 2
Min1 Minor Deductions 1
Min2 Minor Deductions 2
Mod Moderate Deductions
Sal Salvage only
Sev Severely Damaged
Typ Typical Functionality

FireplaceQu
calidad de la chimenea

Codigo Tipo
Ex Excellent - Exceptional Masonry Fireplace
Fa Fair - Prefabricated Fireplace in basement
Gd Good - Masonry Fireplace in main level
NA No Fireplace
Po Poor - Ben Franklin Stove
TA Average - Prefabricated Fireplace in main living area or Masonry Fireplace in basement

GarageType
ubicación del garaje

Codigo Tipo
2Types More than one type of garage
Attchd Attached to home
Basment Basement Garage
BuiltIn Built-In (Garage part of house - typically has room above garage)
CarPort Car Port
Detchd Detached from home
NA No Garage

GarageFinish
acabado interior del garaje

Codigo Tipo
Fin Finished
RFn Rough Finished
Unf Unfinished
NA No Garage

GarageQual
calidad de garaje

Codigo Tipo
Ex Excellent
Fa Fair
Gd Good
NA No Garage
Po Poor
TA Typical/Average

GarageCond
condición de garaje

Codigo Tipo
Ex Excellent
Fa Fair
Gd Good
NA No Garage
Po Poor
TA Typical/Average

PavedDrive
calzada pavimentada

Codigo Tipo
N Dirt/Gravel
P Partial Pavement
Y Paved

PoolQC
calidad de la piscina

Codigo Tipo
Ex Excellent
Fa Fair
Gd Good
NA No Pool
TA Average/Typical

Fence
calidad de la cerca

Codigo Tipo
GdPrv Good Privacy
GdWo Good Wood
MnPrv Minimum Privacy
MnWw Minimum Wood/Wire
NA No Fence

MiscFeature
característica miscelánea no cubierta en otras categorías

Codigo Tipo
Elev Elevator
Gar2 2nd Garage (if not described in garage section)
NA None
Othr Other
Shed Shed (over 100 SF)
TenC Tennis Court

SaleType
Tipo de venta

Codigo Tipo
COD Court Officer Deed/Estate
Con Contract 15% Down payment regular terms
ConLD Contract Low Down
ConLI Contract Low Interest
ConLw Contract Low Down payment and low interest
CWD Warranty Deed - Cash
New Home just constructed and sold
Oth Other
VWD Warranty Deed - VA Loan
WD Warranty Deed - Conventional

SaleCondition
Condiciones de venta

Codigo Tipo
Abnorml Abnormal Sale - trade, foreclosure, short sale
AdjLand Adjoining Land Purchase
Alloca Allocation - two linked properties with separate deeds, typically condo with a garage unit
Family Sale between family members
Normal Normal Sale
Partial Home was not completed when last assessed (associated with New Homes)

1.2.3 VARIABLES CATEGORICAS YA CUANTIFICADAS (Integer)

Estas tienen la peculiaridad de que tienen asignada una numeración aunque realmente son categóricas

MSSubClass
la clase de construcción

Codigo Tipo
20 1-STORY 1946 & NEWER ALL STYLES
30 1-STORY 1945 & OLDER
40 1-STORY W/FINISHED ATTIC ALL AGES
45 1-1/2 STORY - UNFINISHED ALL AGES
50 1-1/2 STORY FINISHED ALL AGES
60 2-STORY 1946 & NEWER
70 2-STORY 1945 & OLDER
75 2-1/2 STORY ALL AGES
80 SPLIT OR MULTI-LEVEL
85 SPLIT FOYER
90 DUPLEX - ALL STYLES AND AGES
120 1-STORY PUD (Planned Unit Development) - 1946 & NEWER
150 1-1/2 STORY PUD - ALL AGES
160 2-STORY PUD - 1946 & NEWER
180 PUD - MULTILEVEL - INCL SPLIT LEV/FOYER
190 2 FAMILY CONVERSION - ALL STYLES AND AGES

OverallQual
material general y calidad de acabado

Codigo Tipo
10 Very Excellent
9 Excellent
8 Very Good
7 Good
6 Above Average
5 Average
4 Below Average
3 Fair
2 Poor
1 Very Poor

OverallCond
calificación de la condición general

Codigo Tipo
10 Very Excellent
9 Excellent
8 Very Good
7 Good
6 Above Average
5 Average
4 Below Average
3 Fair
2 Poor
1 Very Poor

1.3 VALORES NULOS Y PERDIDOS

Veamos primero cuantos valores y en cuantas columnas tenemos NA

columnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[columnasNA], is.na)), decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
x
PoolQC 2909
MiscFeature 2814
Alley 2721
Fence 2348
SalePrice 1459
FireplaceQu 1420
LotFrontage 486
GarageYrBlt 159
GarageFinish 159
GarageQual 159
GarageCond 159
GarageType 157
BsmtCond 82
BsmtExposure 82
BsmtQual 81
BsmtFinType2 80
BsmtFinType1 79
MasVnrType 24
MasVnrArea 23
MSZoning 4
Utilities 2
BsmtFullBath 2
BsmtHalfBath 2
Functional 2
Exterior1st 1
Exterior2nd 1
BsmtFinSF1 1
BsmtFinSF2 1
BsmtUnfSF 1
TotalBsmtSF 1
Electrical 1
KitchenQual 1
GarageCars 1
GarageArea 1
SaleType 1


Veamos un listado de los valores NA usados como categoria

Estaban marcados en rojo en su respectiva tabla

Alley tipo de acceso a callejones

Codigo Significado
NA No alley access

BsmtQual Altura del sótano

Codigo Significado
NA No Basement

BsmtCond estado general del sótano

Codigo Significado
NA No Basement

BsmtExposure muros de sotano a ras de suelo o de jardín

Codigo Significado
NA No Basement

BsmtFinType1 Calidad del área acabada del sótano

Codigo Significado
NA No Basement

BsmtFinType2 Calidad del segundo área terminada (si está presente)

Codigo Significado
NA No Basement

FireplaceQu calidad de la chimenea

Codigo Significado
NA No Fireplace

GarageType ubicación del garaje

Codigo Significado
NA No Garage

GarageFinish acabado interior del garaje

Codigo Significado
NA No Garage

GarageQual calidad de garaje

Codigo Significado
NA No Garage

GarageCond condición de garaje

Codigo Significado
NA No Garage

PoolQC calidad de la piscina

Codigo Significado
NA No Pool

Fence calidad de la cerca

Codigo Significado
NA No Fence

MiscFeature característica miscelánea no cubierta en otras categorías

Codigo Significado
NA None



Podemos apreciar que en todas las variables donde aparece (Callejon, Sotanos, Garages, Piscinas, Cerca y Varios), el sentido que se le da es “Ninguno” o “No existe”.

Por lo que podemos cambiar el código en esas variables por NONE

#Cambio los NA por NONE en cada variable
total$Alley[is.na(total$Alley)]<-'NONE'
total$BsmtQual[is.na(total$BsmtQual)]<-'NONE'
total$BsmtCond[is.na(total$BsmtCond)]<-'NONE'
total$BsmtExposure[is.na(total$BsmtExposure)]<-'NONE'
total$BsmtFinType1[is.na(total$BsmtFinType1)]<-'NONE'
total$BsmtFinType2[is.na(total$BsmtFinType2)]<-'NONE'
total$FireplaceQu[is.na(total$FireplaceQu)]<-'NONE'
total$GarageType[is.na(total$GarageType)]<-'NONE'
total$GarageFinish[is.na(total$GarageFinish)]<-'NONE'
total$GarageQual[is.na(total$GarageQual)]<-'NONE'
total$GarageCond[is.na(total$GarageCond)]<-'NONE'
total$PoolQC[is.na(total$PoolQC)]<-'NONE'
total$Fence[is.na(total$Fence)]<-'NONE'
total$MiscFeature[is.na(total$MiscFeature)]<-'NONE'

Volvemos a comprobar cuantas columnas quedan con valores NA

columnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[columnasNA], is.na)), decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
x
SalePrice 1459
LotFrontage 486
GarageYrBlt 159
MasVnrType 24
MasVnrArea 23
MSZoning 4
Utilities 2
BsmtFullBath 2
BsmtHalfBath 2
Functional 2
Exterior1st 1
Exterior2nd 1
BsmtFinSF1 1
BsmtFinSF2 1
BsmtUnfSF 1
TotalBsmtSF 1
Electrical 1
KitchenQual 1
GarageCars 1
GarageArea 1
SaleType 1



Vemos ahora las variables que nos quedan por comprobar

1.3.1 GARAJE

 GarageYrBlt -->  159 registros        GarageCars -->     1 registros             GarageArea -->  1 registros



1.3.1.1 GARAGE TYPE

Vamos a ver con que valores de GarageType se correponden estos NA


prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%select(Id,GarageType)
prueba[,2]<-as.factor(prueba[,2])
levels(prueba[,2])
## [1] "Detchd" "NONE"


Seleccionamos especificamente los registros que no tienen garaje

Ponemos a 0 el año en aquellos que no tienen garage

prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%filter(GarageType=='NONE')%>%select(Id,GarageType)

total[prueba[,1],60]<-0


Vemos los registros que nos han quedado


prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageCars,GarageArea,GarageQual,GarageCond)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id GarageType GarageYrBlt GarageFinish GarageCars GarageArea GarageQual GarageCond
2127 Detchd NA NONE 1 360 NONE NONE
2577 Detchd NA NONE NA NA NONE NONE

1.3.1.2 GARAGE CARS y GARAGE AREA

1.3.1.2.1 Registro 2577

Parece claro que este registro no tiene garage

total[2577,59]<-'NONE'
total[2577,60]<-0
total[2577,62]<-0
total[2577,63]<-0


Buscamos registros con GarageType y GarageCars iguales al registro 2127 y seleccionamos los mas usados

prueba2<-total%>%filter(GarageType=="Detchd"&GarageCars==1)%>%select(Id,YearBuilt,YearRemodAdd,GarageType,GarageYrBlt,GarageFinish,GarageCars,GarageArea,GarageQual,GarageCond)
freq<-as.data.frame(table(prueba2$GarageFinish,prueba2$GarageQual,prueba2$GarageCond))
kable(head(freq[order(freq$Freq,decreasing = TRUE),]))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Var2 Var3 Freq
144 Unf TA TA 268
128 Unf Fa TA 40
32 Unf Fa Fa 25
48 Unf TA Fa 18
143 RFn TA TA 6
104 Unf Fa Po 4

Asignamos

total[2127,61]<-"Unf"
total[2127,64]<-"TA"
total[2127,65]<-"TA"



Miramos el valor superior entre YearBuilt y YearRemodAdd y lo asignamos a GarageYrBlt

kable(total%>%filter(Id==2127)%>%select(YearBuilt,YearRemodAdd))
YearBuilt YearRemodAdd
1910 1983
total[2127,60]<-1983



1.3.2 SOTANO (BASEMENT)



 BsmtFullBath -->  2 registros        BsmtHalfBath -->  2 registros        BsmtFinSF1 -->  1 registro                        BsmtFinSF2 -->  1 registro          BsmtUnfSF -->  1 registro        TotalBsmtSF -->  1 registro  



prueba<-total%>%filter(is.na(BsmtFullBath)|is.na(BsmtHalfBath))%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,BsmtFullBath,BsmtHalfBath,TotalBsmtSF)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id BsmtQual BsmtCond BsmtExposure BsmtFinType1 BsmtFinSF1 BsmtFinType2 BsmtFinSF2 BsmtUnfSF BsmtFullBath BsmtHalfBath TotalBsmtSF
2121 NONE NONE NONE NONE NA NONE NA NA NA NA NA
2189 NONE NONE NONE NONE 0 NONE 0 0 NA NA 0



Evidentemente ninguno de estos dos registros tiene sotano por lo que los registros que están con NA hay que ponerlos a 0

total[2121,35]<-0
total[2121,37]<-0
total[2121,38]<-0
total[2121,39]<-0
total[2121,48]<-0
total[2121,49]<-0

total[2189,48]<-0
total[2189,49]<-0


Verificamos campos discordantes de sotano

prueba<-total%>%filter(BsmtCond=='NONE'|BsmtQual=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtCond,BsmtQual,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,TotalBsmtSF,BsmtFullBath,BsmtHalfBath)
kable(prueba%>%filter(BsmtCond!='NONE'|BsmtQual!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id BsmtCond BsmtQual BsmtExposure BsmtFinType1 BsmtFinSF1 BsmtFinType2 BsmtFinSF2 BsmtUnfSF TotalBsmtSF BsmtFullBath BsmtHalfBath
333 TA Gd No GLQ 1124 NONE 479 1603 3206 1 0
949 TA Gd NONE Unf 0 Unf 0 936 936 0 0
1488 TA Gd NONE Unf 0 Unf 0 1595 1595 0 0
2041 NONE Gd Mn GLQ 1044 Rec 382 0 1426 1 0
2186 NONE TA No BLQ 1033 Unf 0 94 1127 0 1
2218 Fa NONE No Unf 0 Unf 0 173 173 0 0
2219 TA NONE No Unf 0 Unf 0 356 356 0 0
2349 TA Gd NONE Unf 0 Unf 0 725 725 0 0
2525 NONE TA Av ALQ 755 Unf 0 240 995 0 0



Procedemos a modificar los campos discordantes por registros similares


1.3.2.0.1 Registro 333 (BsmtFinType2=NONE)

Buscamos registros parecidos y asignamos

prueba1<-total%>%filter(BsmtCond=='TA'& BsmtQual=='Gd'& BsmtExposure=='No'& BsmtFinType1=='GLQ' & BsmtFinType2!='Unf' & BsmtFullBath==1)%>%select(Id,BsmtCond,BsmtQual,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,TotalBsmtSF,BsmtFullBath,BsmtHalfBath)
sort(table(prueba1$BsmtFinType2),decreasing = TRUE)
## 
##  ALQ  Rec  BLQ  LwQ NONE 
##    4    2    1    1    1
total[333,36]<-'ALQ'



1.3.2.0.2 Registros 949,1488 y 2349 (BsmtExposure=NONE)

Estos tres registros coinciden en los campos salvo en BsmtUnSF

Buscamos registros parecidos, comparamos y asignamos

prueba1<-total%>%filter( BsmtFinType1=='Unf' & BsmtCond=='TA'& BsmtQual=='Gd' )%>%select(Id,BsmtExposure,BsmtUnfSF,TotalBsmtSF)
table(prueba1$BsmtExposure)
## 
##   Av   Gd   Mn   No NONE 
##   58   10   22  255    3

prop.table(table(prueba1$BsmtExposure))
## 
##         Av         Gd         Mn         No       NONE 
## 0.16666667 0.02873563 0.06321839 0.73275862 0.00862069

muro<-ggplot(prueba1,aes(x=BsmtExposure,y=BsmtUnfSF))
muro<-muro+geom_boxplot(varwidth = TRUE)
muro



No se aprecia relacion evidente entre el tamaño del sotano y el tipo de muro.

Ademas el campo con mas casos tiene casi un 75%. Lo aplicamos en estos registros

total[949,33]<-'No'
total[1488,33]<-'No'
total[2349,33]<-'No'



1.3.2.0.3 Registros 2041,2186 y 2525 (BsmtCond=NONE)

No tienen campos en comun. Buscamos por el valor mas representativo

table(total$BsmtCond)
## 
##   Fa   Gd NONE   Po   TA 
##  104  122   82    5 2606


Asignamos el valor TA

total[2041,32]<-'TA'
total[2186,32]<-'TA'
total[2525,32]<-'TA'



1.3.2.0.4 Registros 2218 y 2219 (BsmtQual=NONE)

Buscamos registros con campos comunes iguales

prueba1<-total%>%filter( BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
Ex 26
Fa 54
Gd 269
NONE 2
TA 338



Estan repartidos. Hay que buscar mas

Filtro por el campo BsmtCond que es diferente en cada registro

prueba1<-total%>%filter( BsmtCond=='Fa' & BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
Fa 13
Gd 2
NONE 1
TA 31
prueba1<-total%>%filter( BsmtCond=='TA' & BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
Ex 20
Fa 38
Gd 258
NONE 1
TA 304



En ambos casos el valor mas usado es ‘TA’. Lo aplicamos

total[2218,31]<-'TA'
total[2219,31]<-'TA'



1.3.3 MAMPOSTERIA (MasVnr)



 MasVnrType -->  24 registros        MaVnrArea -->  23 registros  



Vamos a ver los registros con NA relacionados con la albañileria

prueba<-total%>%filter(is.na(MasVnrType))%>%select(Id,MasVnrType,MasVnrArea)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id MasVnrType MasVnrArea
235 NA NA
530 NA NA
651 NA NA
937 NA NA
974 NA NA
978 NA NA
1244 NA NA
1279 NA NA
1692 NA NA
1707 NA NA
1883 NA NA
1993 NA NA
2005 NA NA
2042 NA NA
2312 NA NA
2326 NA NA
2341 NA NA
2350 NA NA
2369 NA NA
2593 NA NA
2611 NA 198
2658 NA NA
2687 NA NA
2863 NA NA



Uno de los elementos a seleccionar en MasVnrType es None. Ponemos los NA como None y el area a 0

total$MasVnrArea[is.na(total$MasVnrType)==TRUE]<-0
total$MasVnrType[is.na(total$MasVnrType)==TRUE]<-'None'



Compruebo si estan bien todos las areas con un tipo None

prueba<-total%>%filter(MasVnrType=='None' & MasVnrArea>0)%>%select(Id,MasVnrArea)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id MasVnrArea
625 288
774 1
1231 1
1301 344
1335 312
1670 285
2453 1



Tenemos 7 registros que no tienen el area a 0 y no tienen mamposteria

total$MasVnrArea[total$MasVnrType=='None'& total$MasVnrArea>0]<-0


Compruebo si estan bien todos las areas con valor 0 sin tener un tipo None

prueba<-total%>%filter(MasVnrType!='None' & MasVnrArea==0)%>%select(Id,MasVnrType,MasVnrArea)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id MasVnrType MasVnrArea
689 BrkFace 0
1242 Stone 0
2320 BrkFace 0



Hay tres registros. Como no hay forma de saber el tipo de manposteria, la ponemos como ninguna

total[689,26]<-'None'
total[1242,26]<-'None'
total[2320,26]<-'None'


1.3.4 PROPIEDAD (Lot)



 LotFrontage -->  486 registros



Tenemos 486 registros con NA.

Este es un campo cuantitativo por lo que resultan mas difíciles de definir que los categóricos. Aquí buscamos en pies la longitud de la propiedad que limita con la calle.

Para poder calcularlo vamos a tener en cuenta que conocemos

  • LotArea área de la propiedad , que es cuantitativo,
  • LotShape , que es un factor que indica la configuración de la planta de la propiedad
  • LotConfig otro factor importante en Real State que indica la forma de la propiedad respecto a su entorno
  • Neighborhood, que es el entorno donde esta situada

Para obtener un valor que pueda ser comparado vamos a calcular la relación entre la fachada y la raíz cuadrada del área.

La forma que tiene la propiedad puede ser cuadrada, rectangular, trapezoidal, triangular, de forma irregular, etc. Elegimos la raíz cuadradada del lado de un cuadrado y calculamos la proporción entre el lado del cuadrado que tendría ese área y la longitud real de la fachada.

Esa medida la vamos a agrupar por el vecindario (Neighborhood), la forma de la propiedad (LotConfig) y la regularidad de esa forma (LotShape)

Recomendado:

https://www.mpac.ca/PropertyTypes/PropertyAssessmentProcedures/ProcedureCalculationEffectiveFrontageDepthandAreaResidentialNonWaterfrontProperties

https://en.wikipedia.org/wiki/Land_lot

http://www.gimme-shelter.com/frontage-50043/


#registros con NA
prueba1<-total%>%filter(is.na(LotFrontage)==TRUE)
options(digits=4)
#resto de registros agrupados
prueba2<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(LotShape,LotConfig,Neighborhood)
#Calculo proporcion
prueba2[,82]<-prueba2$LotFrontage/sqrt(prueba2$LotArea)
#Numero y media de las proporciones por agrupaciones
prueba3<-prueba2%>%summarise(cuenta=n(),media=mean(V82))
# De cada registro con NA buscamos que agrupacion le corresponde y le asignamos la proporcion que le corresponde de su grupo adecuada a su area propia
for (i in 1:length(prueba1$Id)){
  lista<-which((prueba1[i,11]==prueba3$LotConfig)&(prueba1[i,8]==prueba3$LotShape)&(prueba1[i,13]==prueba3$Neighborhood))
  prueba1[i,82]<-round(prueba3[lista[1],5]*sqrt(prueba1[i,5]))
}
nrow(table(prueba1%>%filter(is.na(media)==TRUE)))
## [1] 40


Faltan 40 registros que no estan conformados por los tres campos.

Reducimos las agrupaciones a dos. LotConfig y Neighborhood

Realizamos las mismas operaciones que en el chunk anterior

prueba11<-prueba1%>%filter(is.na(media)==TRUE)
prueba22<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(LotConfig,Neighborhood)
prueba22[,82]<-prueba22$LotFrontage/sqrt(prueba22$LotArea)
prueba23<-prueba22%>%summarise(cuenta=n(),media=mean(V82))
for (i in 1:length(prueba11$Id)){
  lista<-which((prueba11[i,11]==prueba23$LotConfig)&(prueba11[i,13]==prueba23$Neighborhood))
  prueba11[i,82]<-round(prueba23[lista[1],4]*sqrt(prueba11[i,5]))
}
nrow(table(prueba11%>%filter(is.na(media)==TRUE)))
## [1] 4


Faltan 4 registros que no estan conformados por los dos campos.

Reducimos a Neighborhood y realizamos las misma operaciones

prueba111<-prueba11%>%filter(is.na(media)==TRUE)
prueba222<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(Neighborhood)
prueba222[,82]<-prueba222$LotFrontage/sqrt(prueba222$LotArea)
prueba223<-prueba222%>%summarise(cuenta=n(),media=mean(V82))
for (i in 1:length(prueba111$Id)){
  lista<-which(prueba111[i,13]==prueba223$Neighborhood)
  prueba111[i,82]<-round(prueba223[lista[1],3]*sqrt(prueba111[i,5]))
}
nrow(table(prueba111%>%filter(is.na(media)==TRUE)))
## [1] 0


Ya no quedan registros sin NA en media. Unimos todos los grupos de registros que hemos hecho registros. Reasignamos el valor de media a LotFrontage y ordenamos el conjunto

prueba<-rbind(prueba1[is.na(prueba1$media)==FALSE,],prueba11[is.na(prueba11$media)==FALSE,],prueba111[is.na(prueba111$media)==FALSE,])
prueba$LotFrontage<-prueba$media
total<-rbind(total[is.na(total$LotFrontage)==FALSE,],prueba[,1:81])
#reordenamos
total<-total%>%arrange(Id) 



1.3.5 EXTERIOR



 Exterior1st -->  1 registro        Exterior2nd -->   1 registro



Tenemos dos variables categóricas con 1 NA cada una en el mismo registro.

kable(total%>%filter(is.na(Exterior1st)==TRUE)%>%select(Id,Exterior1st,Exterior2nd))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id Exterior1st Exterior2nd
2152 NA NA
kable(sort(table(total$Exterior1st),decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
VinylSd 1025
MetalSd 450
HdBoard 442
Wd Sdng 411
Plywood 221
CemntBd 126
BrkFace 87
WdShing 56
AsbShng 44
Stucco 43
BrkComm 6
AsphShn 2
CBlock 2
Stone 2
ImStucc 1
kable(sort(table(total$Exterior2nd),decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
VinylSd 1014
MetalSd 447
HdBoard 406
Wd Sdng 391
Plywood 270
CmentBd 126
Wd Shng 81
BrkFace 47
Stucco 47
AsbShng 38
Brk Cmn 22
ImStucc 15
Stone 6
AsphShn 4
CBlock 3
Other 1



Sin mas información escogemos lo mas frecuente

total[2152,24]<-'VinylSD'
total[2152,25]<-'VinylSD'


1.3.6 UTILIDADES (Utilities)



 Utilities -->  2 registros



Tenemos 2 registros con NA en este campo

Vemos como estan distribuidos

kable(total%>%filter(is.na(Utilities)==TRUE)%>%select(Id,Utilities))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id Utilities
1916 NA
1946 NA
kable(sort(table(total$Utilities),decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
AllPub 2916
NoSeWa 1



Como parece evidente ponemos estos dos registros como la inmensa mayoría. Aunque tenerlos casi todos iguales no servirá para predecir nada

total[1916,10]<-'AllPub'
total[1946,10]<-'AllPub'


1.3.7 FUNCIONAL (Functional)



 Functional -->  2 registros



Tenemos 2 registros con NA en este campo

kable(total%>%filter(is.na(Functional)==TRUE)%>%select(Id,Functional))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id Functional
2217 NA
2474 NA
kable(sort(table(total$Functional),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
Typ 2717
Min2 70
Min1 65
Mod 35
Maj1 19
Maj2 9
Sev 2



Ponemos estos registros como Typical que son la mayoría. No tenemos información para mas

total[2217,56]<-'Typ'
total[2474,56]<-'Typ'


1.3.8 ELECTRICO (Electrical)



 Electrical -->  1 registro



Tenemos 1 registro con NA en este campo

kable(total%>%filter(is.na(Electrical)==TRUE)%>%select(Id,Electrical))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id Electrical
1380 NA
kable(sort(table(total$Electrical),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
SBrkr 2671
FuseA 188
FuseF 50
FuseP 8
Mix 1



Ponemos este registro como la mayoría, el estándar

total[1380,43]<-'SBrkr'


1.3.9 COCINA (Kitchen)



 KitchenQual -->  1 registro



Tenemos 1 registro con NA

kable(total%>%filter(is.na(KitchenQual)==TRUE)%>%select(Id,KitchenQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id KitchenQual
1556 NA
kable(sort(table(total$KitchenQual),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
TA 1492
Gd 1151
Ex 205
Fa 70



Como solo es un registro podemos ponerle el valor mayoritario sin que afecte mucho

total[1556,54]<-'TA'


Por otro lado tenemos tres registros con un numero de cocinas por encima del suelo igual a 0, pero sin embargo su calidad es Typical

kable(total%>%filter(KitchenAbvGr==0)%>%select(Id,KitchenAbvGr,KitchenQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id KitchenAbvGr KitchenQual
955 0 TA
2588 0 TA
2860 0 TA



En principio no es paradójico puesto que no existe la opción de NONE en KitchenQual

1.3.10 VENTA (Sale)



 SaleType -->  1 registro



Tenemos 1 registro con NA en el campo SaleType

kable(total%>%filter(is.na(SaleType)==TRUE)%>%select(Id))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id
2490
kable(sort(table(total$SaleType),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
WD 2525
New 239
COD 87
ConLD 26
CWD 12
ConLI 9
ConLw 8
Oth 7
Con 5



Como solo es un registro podemos ponerle el valor mayoritario sin que afecte mucho

total[2490,79]<-'WD'


1.3.11 ZONIFICACION



 MSZoning -->  4 registro



Tenemos 4 registros con NA

kable(total%>%filter(is.na(MSZoning)==TRUE)%>%select(Id))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id
1916
2217
2251
2905
kable(sort(table(total$MSZoning),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
RL 2265
RM 460
FV 139
RH 26
C (all) 25



En este caso vamos a ver la relación entre el tipo de zonificación y el barrio, MSZoning y Neighborhood

plotPru<-ggplot(data=total,aes(x=total$Neighborhood,y=total$MSZoning))
plotPru<-plotPru+geom_count()+labs(x="BARRIOS",y="ZONIFICACION")
plotPru<-plotPru+theme(axis.text.x = element_text(angle = 90,hjust=1,vjust=0.5),title = element_text(color="blue",size=12,lineheight = 1))
plotPru



Compruebo los registros con NA

kable(total%>%filter(is.na(MSZoning)==TRUE)%>%select(Id,MSZoning,Neighborhood))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id MSZoning Neighborhood
1916 NA IDOTRR
2217 NA IDOTRR
2251 NA IDOTRR
2905 NA Mitchel



A destacar:

  • en IDOTRR donde tenemos tres registros no existe ninguna vivienda zonificada como RL que es la mayoritaria en el conjunto de Ames.
  • En el barrio de Mitchel , donde esta el otro registro, sí es RL la mayoritaria

Vuelvo a comprobar separando los barrios. Para los registros del barrio de IDOTRR

prueba1<-total%>%filter(is.na(MSZoning)==FALSE)%>%filter(Neighborhood=='IDOTRR')
kable(sort(table(prueba1$MSZoning),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
RM 68
C (all) 22



Escojo como valor mayoritario RM

total[1916,3]<-'RM'
total[2217,3]<-'RM'
total[2251,3]<-'RM'


Para el otro barrio

prueba1<-total%>%filter(is.na(MSZoning)==FALSE)%>%filter(Neighborhood=='Mitchel')
kable(sort(table(prueba1$MSZoning),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
RL 104
RM 9



Escojo como valor mas usado RL

total[2905,3]<-'RL'



1.3.12 CONCLUSION



Comprobamos cuantos valores nos quedan con NA

#Comprobamos cuantos NA nos quedan
ColumnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[ColumnasNA], is.na)), decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
x
SalePrice 1459



Que es la variable objetivo



1.4 CONTRADICCIONES

Vamos a buscar contradicciones entre características similares

1.4.1 PISCINA (Pool)



No se puede establecer una relacion directa entre la calidad de la piscina y el area. Buscamos en la calidad general de la casa

kable(total%>%filter(PoolArea>0 & PoolQC=='NONE')%>%select(Id,PoolQC,PoolArea))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id PoolQC PoolArea
2421 NONE 368
2504 NONE 444
2600 NONE 561



Tenemos tres registros que tienen un area de piscina sin tenerla

Vemos como están distribuidas las piscinas

kable(sort(table(total$PoolQC),decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
NONE 2909
Ex 4
Gd 4
Fa 2



La gran mayoría de las casas no tienen piscina. Para poder encontrar un criterio con el que dar una cualificación a los registros que faltan buscaremos algún tipo de relación

prueba<-total%>%filter(PoolArea>0 )%>%select(Id,PoolQC,PoolArea,OverallQual,OverallCond)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id PoolQC PoolArea OverallQual OverallCond
198 Ex 512 8 4
811 Fa 648 6 6
1171 Gd 576 6 6
1183 Ex 555 10 5
1299 Gd 480 10 5
1387 Fa 519 7 5
1424 Gd 738 6 7
1975 Ex 144 10 5
2421 NONE 368 4 6
2504 NONE 444 6 5
2574 Ex 228 8 5
2600 NONE 561 3 5
2711 Gd 800 7 4


plotPru2<-ggplot(data=prueba,aes(x=prueba$PoolQC,y=prueba$OverallQual))
plotPru2<-plotPru2+geom_boxplot()
plotPru2



plotPru2<-ggplot(data=prueba,aes(x=prueba$PoolQC,y=prueba$PoolArea))
plotPru2<-plotPru2+geom_boxplot()
plotPru2



Parece que existe cierta relacion entre la calidad general y el area de piscina Vamos a verlo numericamente

options(digits = 3)
prueba$razon<-(prueba$OverallQual*100)/prueba$PoolArea
#Ordenamos
prueba<-prueba%>%arrange(desc(prueba$razon))
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id PoolQC PoolArea OverallQual OverallCond razon
1975 Ex 144 10 5 6.944
2574 Ex 228 8 5 3.509
1299 Gd 480 10 5 2.083
1183 Ex 555 10 5 1.802
198 Ex 512 8 4 1.562
2504 NONE 444 6 5 1.351
1387 Fa 519 7 5 1.349
2421 NONE 368 4 6 1.087
1171 Gd 576 6 6 1.042
811 Fa 648 6 6 0.926
2711 Gd 800 7 4 0.875
1424 Gd 738 6 7 0.813
2600 NONE 561 3 5 0.535



Si se puede establecer una cierta relación , por lo que asignamos la calidad de la piscina asi

total[2504,73]<-'Gd'
total[2421,73]<-'Gd'
total[2600,73]<-'Fa'

1.4.2 CHIMENEA (Fireplace)



No existe contradiccion entre el numero de chimeneas y la calidad

nrow(total%>%filter(Fireplaces>0 & FireplaceQu=='NONE')%>%select(Id,Fireplaces,FireplaceQu,OverallQual,OverallCond))
## [1] 0



1.4.3 SOTANO (Basement)



En las areas tenemos que el area del tipo 1 + area del tipo 2 + area sin terminar = Area total

Comprobamos y buscamos incongruencias

prueba<-total%>%select(Id,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
prueba[,2]<--prueba[,2]
prueba[,6]<-apply(prueba[,2:5],1,sum)
nrow(prueba%>%filter(V6>0))
## [1] 0



No existe ningun registro con el area mal

En los registros sin sotano compruebo que no exista algún campo que no corresponda

Existen 79 registros que no tienen sotano

prueba<-total%>%filter(BsmtQual=='NONE'|BsmtCond=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
prueba1<-prueba%>%filter(BsmtQual!='NONE'|BsmtCond!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'|BsmtFullBath>0|BsmtHalfBath>0)%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
nrow(prueba1)
## [1] 0



Ninguno de ellos tiene incongruencias

Busco los sotanos existentes que no tienen area construida en el primer tipo

prueba<-total%>%filter(BsmtFinType1!='NONE' & BsmtFinSF1==0 )%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
kable(table(prueba$BsmtFinType1,prueba$BsmtFinType2))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Unf
Unf 851

kable(table(prueba$BsmtFinSF1,prueba$BsmtFinSF2))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
0
0 851

nrow(prueba%>%filter(prueba$BsmtUnfSF==0))
## [1] 0



Todos los registros aparecen como Unf Inacabado. Es correcto

1.4.4 GARAGE



En los inmuebles sin garaje buscamos registros que tengan campos con contradicciones o incongruencias

prueba<-total%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE')%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))
## [1] 0



En los inmuebles con garaje buscamos registros que tengan campos con contradicciones o incongruencias

prueba<-total%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE' | GarageYrBlt==0 | GarageCars==0 | GarageArea==0)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))
## [1] 0



1.5 CAMBIOS EN TIPOLOGIAS



1.5.1 CATEGORICAS



Teniendo en cuenta que para el análisis con las variable independientes categóricas se crearan variables “dummy”, tantas como categorías-1 por cada variable, parece claro pensar que favorece reducir el numero de variables, reduciendo la complejidad.

En nuestro caso , y en mi opinión es posible realizarlo cambiando ciertas variables de categóricas a ordinales. Sobre todo en aquellas que tengan un orden que parezca lógico.

Para seguir un criterio razonable, he escogido la transformación creciente desde 0 hasta el numero de categorías dentro de cada variable, siempre desde menos a mas, o si se prefiere de peor a mejor, pero con la salvedad de que 0 solo se escoge para la categoría que significa que no existe esa variable.

Por simplificar con un ejemplo, puedo tener una variable que me habla de la calidad del acabado del garaje, dentro de las cuales tengo varias categorías que van desde una mala calidad a una muy buena. Evidentemente el orden es creciente con el máximo valor para la mejor de las categorías, pero el 0 se reserva solo si dentro de esas categorías me aparece una indicando que no tiene garaje

Estas son las variables categóricas que he seleccionado, y al lado la asignación que le doy a cada categoría de cada una de ellas

LotShape
forma general de la propiedad

Codigo Tipo
Reg 4 Regular
IR1 3 Slightly irregular
IR2 2 Moderately Irregular
IR3 1 Irregular

LandSlope
Pendiente de la propiedad

Codigo Tipo
Gtl 3 Gentle slope
Mod 2 Moderate Slope
Sev 1 Severe Slope

ExterQual
calidad del material exterior

Codigo Tipo
Ex 5 Excellent
Gd 4 Good
TA 3 Average/Typical
Fa 2 Fair
Po 1 Poor

ExterCond
estado actual del material en el exterior

Codigo Tipo
Ex 5 Excellent
Gd 4 Good
TA 3 Average/Typical
Fa 2 Fair
Po 1 Poor

BsmtQual
Altura del sótano

Codigo Tipo
Ex 5 Excellent (100+ inches)
Gd 4 Good (90-99 inches)
TA 3 Typical (80-89 inches)
Fa 2 Fair (70-79 inches)
Po 1 Poor (<70 inches
NONE 0 No Basement

BsmtCond
estado general del sótano

Codigo Tipo
Ex 5 Excellent
Gd 4 Good
TA 3 Typical - slight dampness allowed
Fa 2 Fair - dampness or some cracking or settling
Po 1 Poor - Severe cracking, settling, or wetness
NONE 0 No Basement

BsmtExposure
muros de sotano a ras de suelo o de jardín

Codigo Tipo
Gd 4 Good Exposure
Av 3 Average Exposure (split levels or foyers typically score average or above)
Mn 2 Mimimum Exposure
No 1 No Exposure
NONE 0 No Basement

BsmtFinType1
Calidad del área acabada del sótano

Codigo Tipo
GLQ 6 Good Living Quarters
ALQ 5 Average Living Quarters
BLQ 4 Below Average Living Quarters
Rec 3 Average Rec Room
LwQ 2 Low Quality
Unf 1 Unfinshed
NONE 0 No Basement

BsmtFinType2
Calidad del segundo área terminada (si está presente)

Codigo Tipo
GLQ 6 Good Living Quarters
ALQ 5 Average Living Quarters
BLQ 4 Below Average Living Quarters
Rec 3 Average Rec Room
LwQ 2 Low Quality
Unf 1 Unfinshed
NONE 0 No Basement

HeatingQC
Calidad y condición de la calefacción

Codigo Tipo
Ex 5 Excellent
Gd 4 Good
TA 3 Average/Typical
Fa 2 Fair
Po 1 Poor

KitchenQual
calidad de la cocina

Codigo Tipo
Ex 5 Excellent
Gd 4 Good
TA 3 Average/Typical
Fa 2 Fair
Po 1 Poor

FireplaceQu
calidad de la chimenea

Codigo Tipo
Ex 5 Excellent - Exceptional Masonry Fireplace
Gd 4 Good - Masonry Fireplace in main level
TA 3 Average - Prefabricated Fireplace in main living area or Masonry Fireplace in basement
Fa 2 Fair - Prefabricated Fireplace in basement
Po 1 Poor - Ben Franklin Stove
NONE 0 No Fireplace

GarageFinish
acabado interior del garaje

Codigo Tipo
Fin 3 Finished
RFn 2 Rough Finished
Unf 1 Unfinished
NONE 0 No Garage

GarageQual
calidad de garaje

Codigo Tipo
Ex 5 Excellent
Gd 4 Good
TA 3 Average/Typical
Fa 2 Fair
Po 1 Poor
NONE 0 No Garage

GarageCond
condición de garaje

Codigo Tipo
Ex 5 Excellent
Gd 4 Good
TA 3 Average/Typical
Fa 2 Fair
Po 1 Poor
NONE 0 No Garage

PoolQC
calidad de la piscina

Codigo Tipo
Ex 4 Excellent
Gd 3 Good
TA 2 Average/Typical
Fa 1 Fair
NONE 0 No Pool



#Guardamos los cambios y los vuelvo a abrir para que me convierta los caracteres a factor
write.csv(total,file="Total1.csv",row.names = FALSE)
total<-read.csv("Total1.csv",sep=",",header = TRUE)



Las cambiamos

total$BsmtCond<-plyr::revalue(total$BsmtCond,c('NONE'='0','Po'='1','Fa'='2','TA'='3','Gd'='4','Ex'=5))
total$BsmtExposure<-plyr::revalue(total$BsmtExposure,c('NONE'=0,'No'=1,'Mn'=2,'Av'=3,'Gd'=4))
total$BsmtFinType1<-plyr::revalue(total$BsmtFinType1,c('NONE'=0,'Unf'=1,'LwQ'=2,'Rec'=3,'BLQ'=4,'ALQ'=5,'GLQ'=6))
total$BsmtFinType2<-plyr::revalue(total$BsmtFinType2,c('NONE'=0,'Unf'=1,'LwQ'=2,'Rec'=3,'BLQ'=4,'ALQ'=5,'GLQ'=6))
total$BsmtQual<-plyr::revalue(total$BsmtQual,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$ExterCond<-plyr::revalue(total$ExterCond,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$ExterQual<-plyr::revalue(total$ExterQual,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$FireplaceQu<-plyr::revalue(total$FireplaceQu,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$GarageCond<-plyr::revalue(total$GarageCond,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$GarageFinish<-plyr::revalue(total$GarageFinish,c('NONE'=0,'Unf'=1,'RFn'=2,'Fin'=3))
total$GarageQual<-plyr::revalue(total$GarageQual,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$HeatingQC<-plyr::revalue(total$HeatingQC,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$KitchenQual<-plyr::revalue(total$KitchenQual,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$LandSlope<-plyr::revalue(total$LandSlope,c('Sev'=1,'Mod'=2,'Gtl'=3))

total$LotShape<-plyr::revalue(total$LotShape,c('IR3'=1,'IR2'=2,'IR1'=3,'Reg'=4))

total$PoolQC<-plyr::revalue(total$PoolQC,c('NONE'=0,'Fa'=1,'TA'=2,'Gd'=3,'Ex'=4))

total$BsmtCond<-as.numeric(levels(total$BsmtCond))[total$BsmtCond]
total$BsmtExposure<-as.numeric(levels(total$BsmtExposure))[total$BsmtExposure]
total$BsmtFinType1<-as.numeric(levels(total$BsmtFinType1))[total$BsmtFinType1]
total$BsmtFinType2<-as.numeric(levels(total$BsmtFinType2))[total$BsmtFinType2]
total$BsmtQual<-as.numeric(levels(total$BsmtQual))[total$BsmtQual]
total$ExterCond<-as.numeric(levels(total$ExterCond))[total$ExterCond]
total$ExterQual<-as.numeric(levels(total$ExterQual))[total$ExterQual]
total$FireplaceQu<-as.numeric(levels(total$FireplaceQu))[total$FireplaceQu]
total$GarageCond<-as.numeric(levels(total$GarageCond))[total$GarageCond]
total$GarageFinish<-as.numeric(levels(total$GarageFinish))[total$GarageFinish]
total$GarageQual<-as.numeric(levels(total$GarageQual))[total$GarageQual]
total$HeatingQC<-as.numeric(levels(total$HeatingQC))[total$HeatingQC]
total$KitchenQual<-as.numeric(levels(total$KitchenQual))[total$KitchenQual]
total$LandSlope<-as.numeric(levels(total$LandSlope))[total$LandSlope]
total$LotShape<-as.numeric(levels(total$LotShape))[total$LotShape]
total$PoolQC<-as.numeric(levels(total$PoolQC))[total$PoolQC]



1.5.2 ORDINALES

Vamos a revisar las variables que ya teníamos como ordinales en los datos originales

Mientras que OverallQual y OverallCond no ofrecen ninguna duda, MSSubclass me parece que no esta correctamente planteada.

Puede que se usara ese código numerico para identificar mejor las distintas clases de edificación pero no tiene una relación ordinal

Se puede apreciar en este grafico con la relación que tiene con el precio

Revision de las ordinales originales

Train<-total%>%filter(is.na(SalePrice)==FALSE)
PlotClas<-ggplot()
PlotClas<-PlotClas+geom_col(data=Train,aes(x=Train$MSSubClass,y=Train$SalePrice),fill="lightblue")
PlotClas<-PlotClas+labs(x="Clases",y="Precios")
PlotClas



Cambiamos de ordinal a categorica

Cod<-c('20'='1-STORY 1946 & NEWER ALL STYLES','30'='1-STORY 1945 & OLDER','40'='1-STORY W/FINISHED ATTIC ALL AGES','45'='1-1/2 STORY - UNFINISHED ALL AGES','50'='1-1/2 STORY FINISHED ALL AGES','60'='2-STORY 1946 & NEWER','70'='2-STORY 1945 & OLDER','75'='2-1/2 STORY ALL AGES','80'='SPLIT OR MULTI-LEVEL','85'='SPLIT FOYER','90'='DUPLEX - ALL STYLES AND AGES','120'='1-STORY PUD (Planned Unit Development) - 1946 & NEWER','150'='1-1/2 STORY PUD - ALL AGES','160'='2-STORY PUD - 1946 & NEWER','180'='PUD - MULTILEVEL - INCL SPLIT LEV/FOYER','190'='2 FAMILY CONVERSION - ALL STYLES AND AGES')
total$MSSubClass<-as.factor(total$MSSubClass)
total$MSSubClass<-plyr::revalue(total$MSSubClass,Cod)



1.5.3 CUANTITATIVAS



En el caso de variables cuantitativas originalmente en el dataset , vamos a revisar aquellas que no tengan justificación como numericas

#Columnas con valores numericos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



Antes de empezar voy a revisar la normalidad de las variables cuantitativas para lo cual he creado un pequeño codigo

#Preparar datos
options(digits=18)
normal<-data.frame()
for (i in 1:length(TrainNum)){
  normal[i,1]<-colnames(TrainNum[i])
  normal[i,2]<-shapiro.test(TrainNum[,i])[[2]]
  if (normal[i,2]<0.05) {
    normal[i,3]<-'NO'
  }else {
    normal[i,3]<-'SI'
  }
  
}
colnames(normal)<-c('Variable','p-value')
#Numero de variables normales(SI o NO)
table(normal[,3])
## 
## NO 
## 53

El resultado es que ninguna de las 53 variables numéricas tienen normalidad. Esto me sirve para seleccionar el método de correlacion de Spearman

Vemos las variables cuantitativas susceptibles de cambiarse a categoricas

En principio voy a revisar aquellas cuya cantidad represente algo en si misma, y en esta categoría entran todo lo referido a fechas. Repasando una por una

1.5.3.1 MOSOLD (Mes venta)



Vemos como se distribuye

options(digits=6)
mes1<-ggplot()
mes1<-mes1+geom_bar(data=TotalNum,aes(x=TotalNum$MoSold),fill='blue',position = 'stack')
mes1<-mes1+geom_bar(data=TrainNum,aes(x=TrainNum$MoSold),fill='red',position = 'stack')
mes1<-mes1+labs(x='MESES',y='CANTIDAD')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes1



En azul el total de viviendas, y por encima en rojo solo el conjunto de entrenamiento.

No parece que haya excesivas diferencias y en la mayoría de los meses se aprecia visualmente que el conjunto de entrenamiento representa la mitad del total.

Podemos apreciar que la numeración se refiere evidentemente a los meses y refleja una distribución en la venta superior en los meses de Mayo, Junio y Julio.

Veamos si eso afecta a el precio de venta en el conjunto Train

mes<-ggplot(data=TrainNum,aes(x=TrainNum$MoSold,y=TrainNum$SalePrice))
mes<-mes+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
mes<-mes+geom_bar(stat="summary",fun.y="mean",fill="royalblue")
mes<-mes+labs(x='MESES',y='PRECIO MEDIO')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes<-mes+scale_y_continuous(labels = scales::comma)
mes



El precio medio es parecido y no se ve relación con el mes (entre parentesis aparece la cantidad)

mes2<-ggplot()
mes2<-mes2+geom_boxplot(data=TrainNum,aes(x=TrainNum$MoSold,y=TrainNum$SalePrice,group=TrainNum$MoSold))
mes2<-mes2+labs(x='MESES',y='PRECIO ')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes2<-mes2+scale_y_continuous(labels = scales::comma)
mes2



Vemos correlacion

cor(x=TrainNum$MoSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.0694322



En mi opinión con esa correlacion tan próxima a 0 no influye para nada en el precio

1.5.3.2 YRSOLD (Año venta)



Tenemos un total de cuatro años. Veamoslo gráficamente al igual que con los meses

year1<-ggplot()
year1<-year1+geom_bar(data=TotalNum,aes(x=TotalNum$YrSold),fill='blue',position = 'stack')
year1<-year1+geom_bar(data=TrainNum,aes(x=TrainNum$YrSold),fill='red',position = 'stack')
year1<-year1+labs(x='AÑOS',y='CANTIDAD')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year1



year<-ggplot(data=TrainNum,aes(x=TrainNum$YrSold,y=TrainNum$SalePrice))
year<-year+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
year<-year+geom_bar(stat="summary",fun.y="mean",fill="royalblue")
year<-year+labs(x='AÑOS',y='PRECIO MEDIO')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year<-year+scale_y_continuous(labels = scales::comma)
year



year2<-ggplot()
year2<-year2+geom_boxplot(data=TrainNum,aes(x=TrainNum$YrSold,y=TrainNum$SalePrice,group=TrainNum$YrSold))
year2<-year2+labs(x='AÑOS',y='PRECIO')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year2<-year2+scale_y_continuous(labels = scales::comma)
year2



Vemos correlacion

cor(x=TrainNum$YrSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
## [1] -0.0298991



Tiene la particularidad de que nos puede servir para considerar la antigüedad de la vivienda y ahí puede ser relevante que sea numérico. Voy a posponerlo para mas adelante cuando veamos el año de construcción y el de remodelación



1.5.3.3 YearBuilt YearRemodAdd (Año de construccion y Año de remodelacion)



Vemos estas dos variables puesto que están muy relacionadas.

La primera no necesita explicación, en cuanto a la segunda es el año en que la vivienda ha sufrido algún tipo de remodelación.

Si no ha tenido ninguna esta se corresponde con la fecha de construcción

Vamos a ver gráficamente la posible relación con el precio de venta

built<-ggplot()
built<-built+geom_point(data=TrainNum,aes(x=TrainNum$YearBuilt,y=TrainNum$SalePrice),color='blue')
built<-built+labs(x='AÑOS',y='PRECIO',title='CONSTRUCCION')+scale_y_continuous(labels = scales::comma)
built



Vemos ahora para el año de remodelación

built1<-ggplot()
built1<-built1+geom_point(data=TrainNum,aes(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice),color='red')
built1<-built1+labs(x='AÑOS',y='PRECIO',title= 'REMODELACION')+scale_y_continuous(labels = scales::comma)
built1



Tiene la peculiaridad de que computa a partir de 1950, y en ese año tiene un numero extraordinario de casos, 178 en el Train y 361 en el total, seguramente porque se empezaría a computar ese año y todas las que tienen una antigüedad mayor se computan aqui

Parece razonable pensar a la vista de las graficas que existe algún tipo de relación con el precio de venta. Numericamente:

#Correlacion año construccion
cor(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")
## [1] 0.652682
#Correlacion año remodelacion
cor(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")
## [1] 0.571159



¿Que pasaria si distinguimos aquellas casas que han sido remodeladas , y por lo tanto su fecha de remodelacion es diferente a la de construccion, de aquellas que no lo han sido?

Prueba de remodelacion. Creamos una columna. No remodelados=0. Remodelados=1

TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)

#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.643186
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.478056

#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.680097



Esta claro que importa el año de construccion, importa el año de remodelacion, importa si estan o no remodeladas en cuanto afecta a su antigüedad y además tenemos unos valores extraños en 1950 que debemos corregir.

Voy a considerar que ninguna de esas viviendas han sido remodeladas por lo que aplicare a esa variable, la del año de construcción

Aplico a la remodelacion de los de 1950 el año de construccion

total$YearRemodAdd[total$YearRemodAdd<1951]<-total$YearBuilt[total$YearRemodAdd<1951]
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Vuelvo a comprobar correlacion
TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)
#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.613344
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.229517
#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.708576



built3<-ggplot()
built3<-built3+geom_point(data=TrainNum,aes(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,color=Remodelado))
built3<-built3+facet_grid(Remodelado~.,labeller = label_both)+theme(legend.position = 'none')
built3<-built3+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION VIVIENDAS')+scale_y_continuous(labels = scales::comma)
built3



Vamos a afinar un poco mas calculando la antigüedad respecto al año de venta. Creamos una columna nueva:

Calculo antiguedad completa

total$Antiguedad<-total$YrSold-total$YearBuilt
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Buscamos errores
kable(TotalNum%>%filter(Antiguedad<0)%>%select(Id,YearBuilt,YrSold))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id YearBuilt YrSold
2550 2008 2007



Existe un registro con año venta anterior al de la construccion. Lo igualo

total[2550,78]<-2008
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



Busco errores también en el año de remodelación

Revision de incongruencia de datos con YearRemodAdd

kable(TotalNum%>%filter((TotalNum$YrSold-TotalNum$YearRemodAdd)<0)%>%select(Id,YrSold,YearBuilt,YearRemodAdd))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id YrSold YearBuilt YearRemodAdd
524 2007 2007 2008
2296 2007 2007 2008
2550 2008 2008 2009



Corrijo los valores al año de venta

total[524,21]<-2007
total[2296,21]<-2007
total[2550,21]<-2008



Mas incongruencias

kable(TotalNum%>%filter((TotalNum$YearBuilt-TotalNum$YearRemodAdd)>0)%>%select(Id,YrSold,YearBuilt,YearRemodAdd))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id YrSold YearBuilt YearRemodAdd
1877 2009 2002 2001



Corrijo los valores al año de construccion

total[1877,21]<-2002



Volvemos a calcular y actualizar

total$Antiguedad<-total$YrSold-total$YearBuilt
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Vuelvo a comprobar correlacion
TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)
#Calculamos correlacion para remodelados
cor(x=T1$Antiguedad,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] -0.612723
#No remodelados
cor(x=T0$Antiguedad,y=T0$SalePrice,method="spearman",use="na.or.complete")
## [1] -0.706995



built4<-ggplot()
built4<-built4+geom_point(data=TrainNum,aes(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,color=Remodelado))
built4<-built4+facet_grid(Remodelado~.,labeller = label_both)+theme(legend.position = 'none')
built4<-built4+labs(x='AÑOS',y='PRECIO',title='ANTIGUEDAD VIVIENDAS')+scale_y_continuous(labels = scales::comma)
built4



Los valores son parecidos pero al calcular sobre el numero de años se invierte el signo

En conclusión, la antigüedad de la vivienda tiene una relación fuerte con el precio de venta, y además el hecho de ser una vivienda remodelada o no tambien es importante.

Le afecta menos cuando se ha realizado dicha remodelación.

Por lo cual calculamos la antigüedad (ya realizado), calculamos si hay o no remodelación

#Conclusiones
total$Remodelado<-0
total$Remodelado[total$YearBuilt!=total$YearRemodAdd]<-1
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]



Si calculamos la correlacion de la antiguedad respecto al precio tenemos un valor -0.65012.

Hemos visto que los remodelados tienen -0.612723 y los no remodelados -0.706995 lo que significa que están penalizados por el calculo conjunto.

Podriamos pensar que si tomamos la antigüedad como la diferencia entre el año de venta y el de remodelación(teniendo en cuenta que para las viviendas no remodeladas este es igual que el de construcción) obtendríamos una variable mas adecuada, pero es al contrario , el valor de la correlacion es -0.575787.

Hay que encontrar una manera de penalizar a las viviendas remodeladas en su antigüedad

Mi propuesta es penalizar a las viviendas que han sido remodeladas aumentando su antigüedad de manera artificial.

Proporcionalmente al tiempo que se ha tardado en remodelar. ¿Cuánto?. La decima porcentual que tienen de diferencia las correlaciones.

#Penalizacion
TotalNum.remo<-TotalNum%>%filter(Remodelado==1)
summary(TotalNum.remo$YearRemodAdd-TotalNum.remo$YearBuilt)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     1.0     1.0    20.0    29.9    52.0   127.0



Creo una columna donde pongo este calculo

Como la antiguedad la tenemos en enteros y para ser justo con la penalizacion voy a normalizar las variables

Luego le aplicare un 10% de la antigüedad de la remodelación a la antigüedad de la vivienda

total$Penaliza<-total$YearRemodAdd-total$YearBuilt
#Normalizo
total$Antiguedad<-normalize(total$Antiguedad)
total$Penaliza<-normalize(total$Penaliza)
#Penalizo
total$Antiguedad<-total$Antiguedad+total$Penaliza*0.1
#Borro las variables auxiliares Remodelado y Penaliza
total$Remodelado<-NULL
total$Penaliza<-NULL
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



1.5.3.4 GarageYrBuilt (Año en el que fue construido el garage)



Eliminamos los valores igual a 0, o sea que no tienen garaje. Ya comprobamos anteriormente la congruencia de los registros

Vemos gráficamente

GarageTOTAno<-TotalNum%>%filter(GarageYrBlt!=0)
garage<-ggplot(data=GarageTOTAno,aes(x=GarageTOTAno$GarageYrBlt))
garage<-garage+geom_histogram(fill='blue')
garage<-garage+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.



Tenemos un outlier. Corresponde al registro 2593. Vamos a ver los datos pertinentes

kable(total%>%filter(Id==2593)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars,YearBuilt,YearRemodAdd,YrSold))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id GarageType GarageYrBlt GarageFinish GarageQual GarageArea GarageCond GarageCars YearBuilt YearRemodAdd YrSold
2593 Attchd 2207 2 3 502 3 2 2006 2007 2007



Podemos inferir que el año real de construcción del garaje es 2007. Modificamos

total[2593,60]<-2007



Recalculamos y volvemos a observar

#Recalcular
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Visualizacion total 
GarageTOTAno<-TotalNum%>%filter(GarageYrBlt!=0)
garage<-ggplot(data=GarageTOTAno,aes(x=GarageTOTAno$GarageYrBlt))
garage<-garage+geom_histogram(fill='blue')
garage<-garage+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.



Verifico que el año de construcción del Garage sea posterior al de la casa

GarageTOTAno$dif<-GarageTOTAno$GarageYrBlt-GarageTOTAno$YearBuilt
kable(GarageTOTAno%>%filter(dif<0)%>%select(Id,YearBuilt,GarageYrBlt))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id YearBuilt GarageYrBlt
30 1927 1920
94 1910 1900
325 1967 1961
601 2005 2003
737 1950 1949
1104 1959 1954
1377 1930 1925
1415 1923 1922
1419 1963 1962
1522 1959 1956
1577 2010 2009
1806 1935 1920
1841 1978 1960
1896 1941 1940
1898 1935 1926
2123 1945 1925
2264 2006 2005
2510 2006 2005



Hay 18 registros que tienen el año de construccion del garage anterior al de la vivienda. Entiendo que se debe a errores tipográficos, como confundir un 4 por un 9 o diferencias pequeñas de tiempo que hacen variar en un año



Ponemos el año como el de la vivienda

total$GarageYrBlt[(total$GarageYrBlt<total$YearBuilt)&(total$GarageYrBlt!=0)]<-total$YearBuilt[(total$GarageYrBlt<total$YearBuilt)&(total$GarageYrBlt!=0)]

#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



Veamos la relación con el precio

#Visualizar train. Eliminamos los que no tienen garaje
GarageAno<-TrainNum%>%filter(GarageYrBlt!=0)

garage1<-ggplot()
garage1<-garage1+geom_point(data=GarageAno,aes(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice))
garage1<-garage1+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage1



Parece existir una relación. Numericamente

cor(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.594246



Hay que tener en cuenta que no he incluido los registros que no tienen garaje.

Si se les incluye, curiosamente la correlacion aumenta.

De todas formas es interesante realizar como con la variable anterior, calcular la antigüedad

#Calculo antiguedad Garaje
total$AntGarage<-total$YrSold-total$GarageYrBlt
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

#Correlacion
cor(x=TrainNum$AntGarage,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
## [1] -0.63301

garage2<-ggplot()
garage2<-garage2+geom_point(data=TrainNum,aes(x=TrainNum$AntGarage,y=TrainNum$SalePrice))
garage2<-garage2+labs(x='AÑOS',y='PRECIO',title='ANTIGUEDAD CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage2



En conclusion para las variables YearBuilt, YearRemodAdd, MoSold, YrSold y GarageYrBlt nos quedamos con Antigüedad y AntGarage como variables importantes para el precio de venta



1.5.3.5 REVISION RESTO CUANTITATIVAS (Sin relacion con fechas)



Vemos a continuacion el resto de variables cuantitativas y relación entre ellas para poder ver si reducimos su numero.

Voy a crear una matriz de correlaciones entre estas variables sin contar en principio con el precio.

Para saber si existe una dependencia entre algunas de ellas que nos pueda servir.

Para eso uso el paquete corrplot

Primero la correlacion de las variables entre si, sin contar con el precio ni las variables ya tratadas

TotalNum.noprice<-TotalNum%>%select(-Id,-SalePrice,-YearBuilt,-YearRemodAdd,-MoSold,-YrSold,-GarageYrBlt )

#Matriz correlaciones
CorrNum<-cor(TotalNum.noprice,method = 'spearman')
#Valores absolutos
CorrNum.abs<-as.data.frame(abs(CorrNum))              
#Pongo a 0 los 1 para encontrar el maximo
CorrNum.abs[which(CorrNum.abs==1,arr.ind = TRUE)]<-0  
#Busco el valor maximo de correlacion en cada variable ahora 
CorrNum.inf<-apply(CorrNum.abs,2,max)                 
#Elimino las filas y columnas con correlacion baja
CorrNum.max<-CorrNum.abs[-(which(CorrNum.inf<0.5)),-(which(CorrNum.inf<0.5))]
#Pongo a 0 los valores inferiores a 0.5
CorrNum.max[which(CorrNum.max<0.5,arr.ind = TRUE)]<-0  
CorrNum.max<-as.matrix(CorrNum.max)

corrplot(CorrNum.max,order = 'hclust',hclust.method = 'ward.D2',sig.level = 0.5,tl.col = 'black',tl.cex = 0.8,tl.srt = 45,addrect = 14,diag = FALSE)



Se ve claramente dependencia en ciertos grupos de variables.

Antes de seguir vamos a ver la correlacion de las variable significativas (superior a 0.5 en términos absolutos) respecto al Precio

#CORRELACION CON PRECIO
TrainNum.price<-TrainNum%>%select(-Id,-YearBuilt,-YearRemodAdd,-MoSold,-YrSold,-GarageYrBlt )
#Matriz correlaciones
CorrPri<-cor(TrainNum.price,method = 'spearman')                        
CorrPri.abs<-as.data.frame(CorrPri)     
#Pongo a 0 los 1 para encontrar el maximo
CorrPri.abs[which(CorrPri.abs==1,arr.ind = TRUE)]<-0  
#Busco el valor maximo de correlacion en cada variable ahora 
CorrPri.inf<-apply(CorrPri.abs,2,max)      
#Busco el valor minimo de correlacion en cada variable ahora 
CorrPri.sup<-apply(CorrPri.abs,2,min)                 
#Elimino las filas y columnas con correlacion baja
CorrPri.max<-CorrPri.abs[-(which(CorrPri.inf<0.5 & CorrPri.sup>-0.5)),-(which(CorrPri.inf<0.5 & CorrPri.sup>-0.5))]  
#Pongo a 0 los valores inferiores a 0.5 y superiores a -0.5
CorrPri.max[which((CorrPri.max<0.5 & CorrPri.max>-0.5),arr.ind = TRUE)]<-0  
CorrPri.max<-as.matrix(CorrPri.max)
#Reordenamos por FPC
Orden.fpc<-corrMatOrder(CorrPri.max,order='FPC')    #Primer Componente principal
CorrNum.fpc<-CorrPri.max[Orden.fpc,Orden.fpc]
#Grafico
corrplot(CorrNum.fpc,type='lower',tl.col = 'black',tl.cex = .8,tl.srt = 30)



En el grafico en la fila inferior tenemos SalePrice.

En rojo las variables con correlacion negativa :

 AntGarage    Antigüedad

En azul las variables predictoras con correlacion positiva:

 GarageArea      GarageCars

 Fireplaces    FireplaceQu

 X1stFlrSF     TotalBsmtSF

 TotRmsAbvGrd  GrLivArea   FullBath

 GarageFinish

 KitchenQual

 BsmtQual

 ExterQual

 OverallQual



Las variables que pongo juntas tienen una correlacion fuerte (ver primer grafico ) entre ellas y cierta explicacion lógica. Las vere a continuación por si se puede reducir el numero de variables predictoras



1.5.3.5.1 ANTIGUEDAD y ANTGARAGE



Es evidente que tiene una gran correlacion porque en cierta medida su valor crece de manera proporcionada.

Si una vivienda tiene un garaje, la antigüedad del garaje crece de igual manera que la antigüedad de la vivienda y suelen ser iguales salvo que el garaje se haya construido después.

De todas formas no soy partidario de unirlas de alguna forma porque la variable AntGarage tiene la peculiaridad de aquellas viviendas sin garaje que hay que mantener

Solo voy a normalizar la varable AntGarage, puesto que Antigüedad ya lo estaba

total$AntGarage<-normalize(total$AntGarage)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



1.5.3.5.2 GARAGECARS Y GARAGEAREA



A pesar de que tienen relación con otras variables la mas importante es entre ellos, y puede parecer lógico puesto que el numero de coches que pueda entrar en un garaje depende directamente del espacio que este tenga

Primero normalizo las variables según función

TotalNum$GarageArea<-normalize(TotalNum$GarageArea)
TotalNum$GarageCars<-normalize(TotalNum$GarageCars)
cor(x=TotalNum$GarageArea,y=TotalNum$GarageCars,method = 'spearman')
## [1] 0.864929



La relacion es positiva. Ambas tienen una correlacion positiva y parecida con respecto al precio

TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

cor(x=TrainNum$GarageArea,y=TrainNum$SalePrice,method = 'spearman')
## [1] 0.649379
cor(x=TrainNum$GarageCars,y=TrainNum$SalePrice,method = 'spearman')
## [1] 0.690711



La opcion que opto es multiplicar ambas variables puesto que GarageCars es discreta y GarageArea es continua.

La nueva variable se convierte en continua, mantiene la normalización y el valor 0 para los que no tienen garaje

TrainNum$Garage2<-TrainNum$GarageArea*TrainNum$GarageCars
cor(x=TrainNum$Garage2,y=TrainNum$SalePrice,method = 'spearman')
## [1] 0.668591



Es una correlacion media de las otras dos

total$GarageTotal<-normalize(total$GarageArea)*normalize(total$GarageCars)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



1.5.3.5.3 FIREPLACES y FIREPLACEQU



Fireplaces es el numero de chimeneas

FireplacesQu es la calidad según vimos cuando se paso de categorica a ordinal

La correlacion positiva entre ellas nos indica que a medida que el numero de chimeneas aumenta también aumenta la calidad

cor(x=total$Fireplaces,y=total$FireplaceQu,method = 'kendall')
## [1] 0.820617



Ademas es una relacion fuerte. v Vemos un grafico

chim<-ggplot(data=TotalNum,aes(x=TotalNum$Fireplaces, y=TotalNum$FireplaceQu))
chim<-chim+geom_count()+labs(x="NUMERO",y="CALIDAD")
chim



Con respecto al precio

cor(x=TrainNum$FireplaceQu,y=TrainNum$SalePrice,method='spearman')
## [1] 0.537602
cor(x=TrainNum$Fireplaces,y=TrainNum$SalePrice,method='spearman')
## [1] 0.519247



La correlacion con el precio no es muy alta y ademas la correlacion entre ellas es altisima, por lo que me quedo con una y descarto la otra

Me quedo con FireplaceQu . La normalizo

total$FireplaceQu<-normalize(total$FireplaceQu)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



1.5.3.5.4 1STFlRSF y TOTALBSMTSF



1stFlrSF corresponde al área del primer piso.

TotalBsmtSF es el área del sotano

La correlacion entre ellos es bastante alta

cor(x=total$X1stFlrSF,y=total$TotalBsmtSF,method='spearman')
## [1] 0.828737



Se presupone que las viviendas que tienen sotano , por lo general el área en planta del sotano es igual que el de la primera planta.

La diferencia por lo general esta en que todas las viviendas tienen primera planta, pero no todas tienen sotano

summary(total$X1stFlrSF)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     334     876    1082    1160    1388    5095
summary(total$TotalBsmtSF)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0     793     989    1051    1302    6110



Vemos un grafico esclarecedor

pru<-ggplot()
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$X1stFlrSF,y=TotalNum$TotalBsmtSF))
pru<-pru+scale_x_continuous(limits=c(0,6150))+scale_y_continuous(limits=c(0,6150))
pru<-pru+labs(x='AREA PRIMER PISO',y='AREA SOTANO')
pru



Se aprecian dos líneas claramente, una siguiendo el eje de abscisas en o que son las viviendas sin sotano y la otra línea de inclinación 45º que son las viviendas que tienen el mismo área de vivienda que de sotano.

Hay que destacar que hay unas cuantas viviendas que tienen mas área de sotano que de primer piso

Vemos su correlacion con el precio

cor(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice,method='spearman')
## [1] 0.575408
cor(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice,method='spearman')
## [1] 0.602725



No parece que haya una correlacion muy alta . Lo vemos gráficamente

pru<-ggplot()
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice),color='red')
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice),color='blue')
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru



Tenemos dos outliers en la esquina inferior derecha. Les busco

kable(TrainNum%>%filter(X1stFlrSF>3000 & SalePrice<200000)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id X1stFlrSF TotalBsmtSF SalePrice
524 3138 3138 184750
1299 4692 6110 160000



Excluyo estos valores para ver si mejora

TrainNum.piso<-TrainNum%>%filter(Id!=524)%>%filter(Id!=1299)



pru<-ggplot()
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice),color='red')
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice),color='blue')
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru



El grafico parece que ha mejorado. Veamos numéricamente

cor(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice,method='spearman')
## [1] 0.576221
cor(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice,method='spearman')
## [1] 0.603604



Sí hay mejoria pero no parece significativa.

En principio no descarto estos registros por si afectan a otras variables

Voy a separar en la variable de área de primera planta a las viviendas que tienen sotano y las que no

#Separo las viviendas por el sotano
TrainNum.sot<-TrainNum%>%filter(TotalBsmtSF==0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)
TrainNum.piso<-TrainNum%>%filter(TotalBsmtSF>0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)



Vemos graficamente

pru<-ggplot()
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice),color='blue',alpha=0.1)
pru<-pru+geom_point(data=TrainNum.sot,aes(x=TrainNum.sot$X1stFlrSF,y=TrainNum.sot$SalePrice),color='red',alpha=0.3)
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru



Se aprecia que las vivendas sin sotano (puntos rojos) están penalizadas en el precio, están en la parte baja de la nube.

En mi opinión se debería combinar ambas variables pero que penalizen a las viviendas sin sotano, parecido a lo que sucedia a la penalizacion en la antigüedad.

Para eso voy a sumar el área del sotano y el de la primera planta

La mayoría de las viviendas verán casi doblada su superficie, pero las viviendas sin sotano se quedan como están

TrainNum$AreaPiso<-TrainNum$X1stFlrSF+TrainNum$TotalBsmtSF



Vemos graficamente

pru<-ggplot()
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$AreaPiso,y=TrainNum$SalePrice),color='blue',alpha=0.2)
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru



La correlacion mejora

cor(x=TrainNum$AreaPiso,y=TrainNum$SalePrice,method='spearman')
## [1] 0.623865



La distribución parece bastante parecida.

Dejamos asi la nueva variable y la normalizamos

total$AreaPiso<-normalize(total$X1stFlrSF+total$TotalBsmtSF)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)



1.5.3.5.5 GRLIVAREA FULLBATH TOTRMSABVGRD



Estas variables corresponde a

 GrLivArea   pies cuadrados del área habitable sobre el nivel del suelo            FullBath  baños completos por encima del suelo          TotRmsAbvGrd  Total de habitaciones por encima del suelo (no incluye baños)

Parece evidente una relación lógica entre la primera variable y las otras dos

kable(cor(total%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
GrLivArea FullBath TotRmsAbvGrd
GrLivArea 1.000000 0.662752 0.808775
FullBath 0.662752 1.000000 0.536076
TotRmsAbvGrd 0.808775 0.536076 1.000000



Graficamente

pru<-ggplot()
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$TotRmsAbvGrd,y=TotalNum$GrLivArea),color='blue',alpha=0.1)
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$FullBath,y=TotalNum$GrLivArea),color='red',alpha=0.3)
pru<-pru+labs(x='Estancias ',y='Area')+scale_y_continuous(labels = scales::comma)
pru



Tenemos dos outliers que con un area habitable superior a 5000 y con 12 y 15 habitaciones solo tiene 2 baños

TotalNum.sala<-TotalNum
kable(TotalNum%>%filter(FullBath==2 & GrLivArea>5000)%>%select(Id,GrLivArea,FullBath,TotRmsAbvGrd))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id GrLivArea FullBath TotRmsAbvGrd
1299 5642 2 12
2550 5095 2 15



Les descarto y compruebo como queda la matriz de correlacion

TotalNum.sala<-TotalNum.sala%>%filter(Id!=1299)%>%filter(Id!=2550)
kable(cor(TotalNum.sala%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))
GrLivArea FullBath TotRmsAbvGrd
GrLivArea 1.000000 0.662584 0.808373
FullBath 0.662584 1.000000 0.535749
TotRmsAbvGrd 0.808373 0.535749 1.000000



Parece que incluso ha empeorado

Pero voy a verlo teniendo en cuenta el precio

TrainNum.sala<-TotalNum.sala%>%filter(is.na(SalePrice)==FALSE)

#Correlacion con outliers
kable(cor(TrainNum%>%select(GrLivArea,FullBath,TotRmsAbvGrd,SalePrice),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
GrLivArea FullBath TotRmsAbvGrd SalePrice
GrLivArea 1.000000 0.658419 0.827874 0.731310
FullBath 0.658419 1.000000 0.558665 0.635957
TotRmsAbvGrd 0.827874 0.558665 1.000000 0.532586
SalePrice 0.731310 0.635957 0.532586 1.000000

#Correlacion sin outliers
kable(cor(TrainNum.sala%>%select(GrLivArea,FullBath,TotRmsAbvGrd,SalePrice),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
GrLivArea FullBath TotRmsAbvGrd SalePrice
GrLivArea 1.000000 0.658246 0.827514 0.732112
FullBath 0.658246 1.000000 0.558364 0.636043
TotRmsAbvGrd 0.827514 0.558364 1.000000 0.533215
SalePrice 0.732112 0.636043 0.533215 1.000000



Se puede observar como al quitar los outliers la correlacion entre las variables que estudiamos empeoran pero mejoran todas con respecto al precio.

Lo dejamos en recordatorio como los otros que hemos visto para más adelante

Podemos pensar que si consideramos los baños como una estancia mas podemos unirlo en una sola variable

Pregunta: ¿Qué significa que haya viviendas que no tengan baño?

#Si se suman los baños y las estancias
#¿No tienen baño?
kable(TotalNum%>%filter(FullBath==0)%>%select(Id,HalfBath,BsmtFullBath,BsmtHalfBath))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id HalfBath BsmtFullBath BsmtHalfBath
54 1 2 0
189 2 2 0
376 1 1 0
598 2 0 2
635 0 2 0
917 0 1 0
1164 2 2 0
1214 0 1 1
1271 1 2 0
1860 2 2 0
2514 1 2 0
2601 1 2 0



Respuesta: Que tienen medios baños o baños en el sotano

Esta es la grafica de la relación entre los baños y el precio

pru<-ggplot()
pru<-pru+geom_boxplot(data=TotalNum,aes(x=TotalNum$FullBath,y=TotalNum$SalePrice,group=TotalNum$FullBath),color='red')
pru<-pru+labs(x='Baños ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru
## Warning: Removed 1459 rows containing non-finite values (stat_boxplot).



Las vivendas sin baño están penalizadas en el precio aunque no demasiado

Si sumamos los baños como una estancia mas

#Sumamos los baños
TotalNum$estancias<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd
kable(cor(TotalNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
GrLivArea FullBath TotRmsAbvGrd estancias
GrLivArea 1.000000 0.662752 0.808775 0.852309
FullBath 0.662752 1.000000 0.536076 0.743707
TotRmsAbvGrd 0.808775 0.536076 1.000000 0.960388
estancias 0.852309 0.743707 0.960388 1.000000



Evidentemente la correlacion con las variables que la componen tiene que ser alta, pero con el area habitable mejora bastante la correlacion individual mejor que tenia antes

Voy a sumarle también los medios baños pero reducido a la mitad en su valor

#Sumamos los medios baños
TotalNum$estancias2<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd+(TotalNum$HalfBath/2)
kable(cor(TotalNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias,estancias2),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
GrLivArea FullBath TotRmsAbvGrd estancias estancias2
GrLivArea 1.000000 0.662752 0.808775 0.852309 0.865065
FullBath 0.662752 1.000000 0.536076 0.743707 0.723524
TotRmsAbvGrd 0.808775 0.536076 1.000000 0.960388 0.958442
estancias 0.852309 0.743707 0.960388 1.000000 0.991040
estancias2 0.865065 0.723524 0.958442 0.991040 1.000000



Aunque empeora la correlacion con las otras variables, mejora con el area habitable que es con la que voy a combinarla y normalizarlas

#Combinar con area habitable y normalizar
TotalNum$Habitat<-normalize(TotalNum$estancias2*TotalNum$GrLivArea)
#Comparamos con precio
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
kable(cor(TrainNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias,Habitat,SalePrice),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
GrLivArea FullBath TotRmsAbvGrd estancias Habitat SalePrice
GrLivArea 1.000000 0.658419 0.827874 0.860974 0.974100 0.731310
FullBath 0.658419 1.000000 0.558665 0.751499 0.714628 0.635957
TotRmsAbvGrd 0.827874 0.558665 1.000000 0.964700 0.916140 0.532586
estancias 0.860974 0.751499 0.964700 1.000000 0.948747 0.618233
Habitat 0.974100 0.714628 0.916140 0.948747 1.000000 0.704260
SalePrice 0.731310 0.635957 0.532586 0.618233 0.704260 1.000000



La nueva variable esta mucho mas correlacionada con las tres variables originales y además se acerca bastante a la variable original de mayor correlacion con el precio

Creamos en dataset conjunto y normalizamos

#Crear variable y normalizar
total$Habitat<-normalize((total$FullBath+total$TotRmsAbvGrd+(total$HalfBath/2))*total$GrLivArea)



1.5.3.5.6 Normalizacion de resto de variables


 GarageFinish    acabado interior del garaje

 KitchenQual   calidad de la cocina

 BsmtQual    Altura del sótano

 ExterQual   calidad del material exterior

 OverallQual   material general y calidad de acabado



Son todas variables ordinales que indican distintos acabados/calidades de la vivienda

Es razonable pensar que junto con otras variables que no aparecen por no estar tan relacionadas, mantengan una correspondencia al nivel general de calidad de la vivienda y este está asociado al precio de manera importante.

En mi opinión no tiene justificación lógica el combinar varias de estas variables puesto que no tienen una relación causal a pesar de que tengan una correlacion importante

Las normalizamos

total$GarageFinish<-normalize(total$GarageFinish)
total$KitchenQual<-normalize(total$KitchenQual)
total$BsmtQual<-normalize(total$BsmtQual)
total$ExterQual<-normalize(total$ExterQual)
total$OverallQual<-normalize(total$OverallQual)



1.5.3.5.7 CONCLUSION



De todas las variables cuantitativas nos quedamos con las siguientes:

 Antiguedad    AntGaraje   GarageTotal   FirePlaceQu   AreaPiso    Habitat   GarageFinish    KitchenQual      BsmtQual    ExterQual   OverallQual



De un total de 51 variables numéricas del dataset (excluyendo la identificación Id y el precio de venta) hemos reducido las variables predictoras a 11



1.5.4 FACTORES



En el caso del estudio de las variables categóricas, tenemos que partir de un enfoque diferente

Como estamos hablando de variables categóricas no podemos en principio calcular un valor directo como usábamos el de la correlacion en las variables continuas.

Pero si podemos usar el coeficiente de determinación o bondad del ajuste que en los casos de regresion lineal simple es el cuadrado de la correlacion de Pearson.

La manera simple mas directa es calculando variable por variable

#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact$Id<-total$Id
TotalFact$SalePrice<-total$SalePrice
TrainFact<-TotalFact%>%filter(is.na(SalePrice)==FALSE)

#Calculo directo 
summary(lm(TrainFact$SalePrice ~ TrainFact$Foundation, data = TrainFact))
## 
## Call:
## lm(formula = TrainFact$SalePrice ~ TrainFact$Foundation, data = TrainFact)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -147230  -40230  -11118   24724  529770 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                  132291       5679   23.29   <2e-16 ***
## TrainFact$FoundationCBlock    17515       6300    2.78   0.0055 ** 
## TrainFact$FoundationPConc     92939       6288   14.78   <2e-16 ***
## TrainFact$FoundationSlab     -24926      15115   -1.65   0.0994 .  
## TrainFact$FoundationStone     33668      28586    1.18   0.2391    
## TrainFact$FoundationWood      53376      40025    1.33   0.1826    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 68600 on 1454 degrees of freedom
## Multiple R-squared:  0.256,  Adjusted R-squared:  0.254 
## F-statistic:  100 on 5 and 1454 DF,  p-value: <2e-16



Nos da un 0.2564. Esto equivaldria a una correlacion (si la variable fuera numerica) de 0.50635

Vemos con una de las variables numéricas que calculamos en la sección anterior

#Si comparo con variables numericas
Train<-total%>%filter(is.na(SalePrice)==FALSE)
summary(lm(Train$SalePrice ~ Train$Habitat, data = Train))
## 
## Call:
## lm(formula = Train$SalePrice ~ Train$Habitat, data = Train)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -467275  -28723   -4117   21521  310323 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      99401       2795    35.6   <2e-16 ***
## Train$Habitat   575911      16500    34.9   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 58700 on 1458 degrees of freedom
## Multiple R-squared:  0.455,  Adjusted R-squared:  0.455 
## F-statistic: 1.22e+03 on 1 and 1458 DF,  p-value: <2e-16



Para esta variable =0.4552. Luego la correlacion es 0.674685 Lo comprobamos

cor(x=Train$SalePrice,y=Train$Habitat)
## [1] 0.674692



Es igual. Si la elevamos al cuadrado tenemos 0.45520889

Luego la forma de seleccionar aquellas variables que tienen influencia sobre el precio va a ser calcular el coeficiente de determinación

Ahora bien, tenemos 28 variables categóricas.

Para facilitar esto vamos a usar el paquete FactoMineR.

Tiene varias opciones interesantes para realizar distintas métodos de analisis de datos y entre ellos tiene un método llamado condes() que sirve para describir una variable continua en función de variables continuas y/o categóricas

#Buscamos categorias mas proximas a SalePrice
fact1<-FactoMineR::condes(TrainFact,num.var = 30)



Esto nos genera una lista de tres elementos (como maximo)

  • Una matriz con las variables cualitativas ordenadas por
  • Una matriz con las variables cuantitativas ordenadas por correlacion
  • Una matriz con los coeficientes de cada categoría de las variables cualitativas que cumplen con el p-value asignado

Nuestro interés esta en la primera matriz.

Teniendo en cuenta que para la selección de las variables cuantitativas significativas poníamos como criterio que la correlacion debía ser superior a 0.5, entonces en este caso > (0.5)²=0.25 .

Ese es el limite que ponemos

#Estas son las variables
fact1.cuali<-as.data.frame(fact1[[1]])
kable(fact1.cuali)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
R2 p.value
Neighborhood 0.545575 0.000000
Foundation 0.256368 0.000000
GarageType 0.249204 0.000000
MSSubClass 0.246316 0.000000
MasVnrType 0.180235 0.000000
SaleCondition 0.135497 0.000000
Exterior1st 0.152773 0.000000
Exterior2nd 0.153830 0.000000
SaleType 0.137287 0.000000
MSZoning 0.107560 0.000000
HouseStyle 0.086313 0.000000
CentralAir 0.063166 0.000000
Electrical 0.059651 0.000000
PavedDrive 0.054540 0.000000
RoofStyle 0.057697 0.000000
Fence 0.035615 0.000000
BldgType 0.034534 0.000000
LandContour 0.025794 0.000000
RoofMatl 0.031413 0.000000
Condition1 0.032631 0.000000
Alley 0.020408 0.000000
LotConfig 0.021019 0.000003
Functional 0.016480 0.000484
Heating 0.014437 0.000753
MiscFeature 0.007080 0.035004
Condition2 0.009899 0.043426



Aqui estan las primeras categorias

fact1.var<-as.data.frame(fact1[[2]])
kable(head(fact1.var))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Estimate p.value
PConc 64177.3 0
NridgHt 132305.8 0
2-STORY 1946 & NEWER 85904.5 0
New 88807.5 0
Partial 103104.6 0
Attchd 43339.9 0



Si vemos las variables solo hay dos que superan un de 0.25, pero teniendo en cuenta que como en las variables numéricas no había normalidad y para la correlacion use el método de Spearman que suele dar un valor ligeramente superior al de Pearson, en este caso voy a escoger también las dos variables que se han quedado a las puertas con 0.24

En resumen :

 `Neighborhood`  ubicaciones físicas dentro de los límites de la ciudad de Ames
                    Tiene 25 categorias

 `MSSubClass`    la clase de construcción.   Tiene 16 categorias

 `Foundation`    tipo de cimientos.      Tiene 6 categorias

 `GarageType`    ubicación del garaje        Tiene 7 categorias



Son un total de 54 categorias.

Si usamos one hot encoding suponen (25-1)+(16-1)+(6-1)+(7-1)=50 nuevas variables a añadir a las 11 numericas que ya tenemos.

Hay que reducirlas

Las revisamos:



1.5.4.1 NEIGHBORHOOD (Vecindario)



Esta variable tiene 25 categorias. Veamos grafica y ordenadamente por la media y la mediana

pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Neighborhood,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Barrio',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Neighborhood,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Barrio',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru



Voy a intentar reducir las variables.

Para eso voy a utilizar una clasificación jerarquica aglomerativa sencilla mediante hclust.

Voy a realizar varias clasificaciones y recalcular el coeficiente de determinación que quedaria antes de decidir .Los clusters van de 3 a 8 agrupaciones

Los resultados los presento juntas las cuatro variables

Aqui solo aparecen los dendogramas

#Preparacion
Resultados.vecinos<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos 
train.prueba<-TrainFact%>%group_by(Neighborhood)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Neighborhood
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Barrio',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Barrio',cutree(train.hcl,k=4))
train.dat[,4]<-paste0('Barrio',cutree(train.hcl,k=5))
train.dat[,5]<-paste0('Barrio',cutree(train.hcl,k=6))
train.dat[,6]<-paste0('Barrio',cutree(train.hcl,k=7))
train.dat[,7]<-paste0('Barrio',cutree(train.hcl,k=8))

#Se crean nuevas columnas con los clusters calculados
TrainFact$NeighborhoodMean1<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean1)<- train.dat[,2]
TrainFact$NeighborhoodMean2<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean2)<- train.dat[,3]
TrainFact$NeighborhoodMean3<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean3)<- train.dat[,4]
TrainFact$NeighborhoodMean4<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean4)<- train.dat[,5]
TrainFact$NeighborhoodMean5<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean5)<- train.dat[,6]
TrainFact$NeighborhoodMean6<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean6)<- train.dat[,7]

#Prueba clusterizacion medianas
#Obtencion de los datos 
train.prueba3<-TrainFact%>%group_by(Neighborhood)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$Neighborhood
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Barrio', cutree(train.hcl2,k=3))
train.dat2[,3]<-paste0('Barrio', cutree(train.hcl2,k=4))
train.dat2[,4]<-paste0('Barrio',cutree(train.hcl2,k=5))
train.dat2[,5]<-paste0('Barrio',cutree(train.hcl2,k=6))
train.dat2[,6]<-paste0('Barrio',cutree(train.hcl2,k=7))
train.dat2[,7]<-paste0('Barrio', cutree(train.hcl2,k=8))

#Se crean nuevas columnas con los clusters calculados
TrainFact$NeighborhoodMedian1<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian1)<- train.dat2[,2]
TrainFact$NeighborhoodMedian2<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian2)<- train.dat2[,3]
TrainFact$NeighborhoodMedian3<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian3)<- train.dat2[,4]
TrainFact$NeighborhoodMedian4<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian4)<- train.dat2[,5]
TrainFact$NeighborhoodMedian5<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian5)<- train.dat2[,6]
TrainFact$NeighborhoodMedian6<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian6)<- train.dat2[,7]

#Presentacion resultados
Resultados.vecinos<-cbind(c(3,4,5,6,7,8,'Todos'))
Resultados.vecinos<-cbind(Resultados.vecinos,c(condes(TrainFact%>%select(Id,NeighborhoodMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Neighborhood,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.vecinos<-cbind(Resultados.vecinos,c(condes(TrainFact%>%select(Id,NeighborhoodMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Neighborhood,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.vecinos<-as.data.frame(Resultados.vecinos)
colnames(Resultados.vecinos)<-c('Numero clusters','R2 Media','R2 Mediana')



1.5.4.2 FOUNDATION (Cimientos)



Esta variable tiene 6 categorias. Veamos grafica y ordenadamente por la media y la mediana


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Foundation,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Tipo de cimiento',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Foundation,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Tipo de cimiento',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru



Realizamos la misma operación que con el vecindario, solo que aquí tenemos 6 grupos por lo que los cluster van de 2 a 5

Los resultados los presento juntas las cuatro variables

Aqui solo aparecen los dendogramas

#Preparacion
Resultados.cimientos<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos 
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimiento',cutree(train.hcl,k=2))
train.dat[,3]<-paste0('Cimiento',cutree(train.hcl,k=3))
train.dat[,4]<-paste0('Cimiento',cutree(train.hcl,k=4))
train.dat[,5]<-paste0('Cimiento',cutree(train.hcl,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$FoundationMean1<-TrainFact$Foundation
levels(TrainFact$FoundationMean1)<- train.dat[,2]
TrainFact$FoundationMean2<-TrainFact$Foundation
levels(TrainFact$FoundationMean2)<- train.dat[,3]
TrainFact$FoundationMean3<-TrainFact$Foundation
levels(TrainFact$FoundationMean3)<- train.dat[,4]
TrainFact$FoundationMean4<-TrainFact$Foundation
levels(TrainFact$FoundationMean4)<- train.dat[,5]

#Prueba clusterizacion medianas
#Obtencion de los datos 
train.prueba3<-TrainFact%>%group_by(Foundation)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$Foundation
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Cimiento', cutree(train.hcl2,k=2))
train.dat2[,3]<-paste0('Cimiento',cutree(train.hcl2,k=3))
train.dat2[,4]<-paste0('Cimiento',cutree(train.hcl2,k=4))
train.dat2[,5]<-paste0('Cimiento',cutree(train.hcl2,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$FoundationMedian1<-TrainFact$Foundation
levels(TrainFact$FoundationMedian1)<- train.dat2[,2]
TrainFact$FoundationMedian2<-TrainFact$Foundation
levels(TrainFact$FoundationMedian2)<- train.dat2[,3]
TrainFact$FoundationMedian3<-TrainFact$Foundation
levels(TrainFact$FoundationMedian3)<- train.dat2[,4]
TrainFact$FoundationMedian4<-TrainFact$Foundation
levels(TrainFact$FoundationMedian4)<- train.dat2[,5]

#Presentacion resultados
Resultados.cimientos<-cbind(c(2,3,4,5,'Todos'))
Resultados.cimientos<-cbind(Resultados.cimientos,c(condes(TrainFact%>%select(Id,FoundationMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Foundation,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.cimientos<-cbind(Resultados.cimientos,c(condes(TrainFact%>%select(Id,FoundationMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Foundation,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.cimientos<-as.data.frame(Resultados.cimientos)
colnames(Resultados.cimientos)<-c('Numero clusters','R2 Media','R2 Mediana')



1.5.4.3 GARAGETYPE (Ubicacion del garage)



Esta variable tiene 7 categorias. Veamos grafica y ordenadamente por la media y la mediana

pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$GarageType,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Ubicacion Garaje',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$GarageType,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Ubicacion Garaje',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru



Realizamos la misma operación que con el vecindario, solo que aquí tenemos 7 grupos por lo que los cluster van de 2 a 5

Los resultados los presento juntas las cuatro variables

Aqui solo aparecen los dendogramas

#Preparacion
Resultados.garage<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos 
train.prueba<-TrainFact%>%group_by(GarageType)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$GarageType
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('garage',cutree(train.hcl,k=2))
train.dat[,3]<-paste0('garage',cutree(train.hcl,k=3))
train.dat[,4]<-paste0('garage',cutree(train.hcl,k=4))
train.dat[,5]<-paste0('garage',cutree(train.hcl,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$GarageTypeMean1<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean1)<- train.dat[,2]
TrainFact$GarageTypeMean2<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean2)<- train.dat[,3]
TrainFact$GarageTypeMean3<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean3)<- train.dat[,4]
TrainFact$GarageTypeMean4<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean4)<- train.dat[,5]

#Prueba clusterizacion medianas
#Obtencion de los datos 
train.prueba3<-TrainFact%>%group_by(GarageType)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$GarageType
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('garage', cutree(train.hcl2,k=2))
train.dat2[,3]<-paste0('garage',cutree(train.hcl2,k=3))
train.dat2[,4]<-paste0('garage',cutree(train.hcl2,k=4))
train.dat2[,5]<-paste0('garage',cutree(train.hcl2,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$GarageTypeMedian1<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian1)<- train.dat2[,2]
TrainFact$GarageTypeMedian2<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian2)<- train.dat2[,3]
TrainFact$GarageTypeMedian3<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian3)<- train.dat2[,4]
TrainFact$GarageTypeMedian4<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian4)<- train.dat2[,5]

#Presentacion resultados
Resultados.garage<-cbind(c(2,3,4,5,'Todos'))
Resultados.garage<-cbind(Resultados.garage,c(condes(TrainFact%>%select(Id,GarageTypeMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageType,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.garage<-cbind(Resultados.garage,c(condes(TrainFact%>%select(Id,GarageTypeMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageType,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.garage<-as.data.frame(Resultados.garage)
colnames(Resultados.garage)<-c('Numero clusters','R2 Media','R2 Mediana')



1.5.4.4 MSSUBCLASS (CLase de construccion)



Esta variable tiene 16 categorias. Veamos grafica y ordenadamente por la media y la mediana

pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$MSSubClass,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Clase Construccion',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 60,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$MSSubClass,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Clase Construccion',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 60,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru



Esta variable es mas peculiar. Vemos sus categorías y apariciones

kable(table(TrainFact$MSSubClass))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
1-STORY 1946 & NEWER ALL STYLES 536
1-STORY 1945 & OLDER 69
1-STORY W/FINISHED ATTIC ALL AGES 4
1-1/2 STORY - UNFINISHED ALL AGES 12
1-1/2 STORY FINISHED ALL AGES 144
2-STORY 1946 & NEWER 299
2-STORY 1945 & OLDER 60
2-1/2 STORY ALL AGES 16
SPLIT OR MULTI-LEVEL 58
SPLIT FOYER 20
DUPLEX - ALL STYLES AND AGES 52
1-STORY PUD (Planned Unit Development) - 1946 & NEWER 87
1-1/2 STORY PUD - ALL AGES 0
2-STORY PUD - 1946 & NEWER 63
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 10
2 FAMILY CONVERSION - ALL STYLES AND AGES 30



Tenemos una categoria con 0 casos en el Train

Buscamos en el dataset Test

TestFact<-TotalFact%>%filter(is.na(SalePrice)==TRUE)
kable(table(TestFact$MSSubClass))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
1-STORY 1946 & NEWER ALL STYLES 543
1-STORY 1945 & OLDER 70
1-STORY W/FINISHED ATTIC ALL AGES 2
1-1/2 STORY - UNFINISHED ALL AGES 6
1-1/2 STORY FINISHED ALL AGES 143
2-STORY 1946 & NEWER 276
2-STORY 1945 & OLDER 68
2-1/2 STORY ALL AGES 7
SPLIT OR MULTI-LEVEL 60
SPLIT FOYER 28
DUPLEX - ALL STYLES AND AGES 57
1-STORY PUD (Planned Unit Development) - 1946 & NEWER 95
1-1/2 STORY PUD - ALL AGES 1
2-STORY PUD - 1946 & NEWER 65
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 7
2 FAMILY CONVERSION - ALL STYLES AND AGES 31



Tiene 1 caso, luego no se puede eliminar directamente de todo el conjunto, pero si debemos NO tomarlo en consideracion para la reduccion de variables porque si no trastornaria todos los calculos

TestFact%>%filter(MSSubClass=='1-1/2 STORY PUD - ALL AGES')%>%select(Id)
#Descarto este level para el calculo
TrainFact$MSSubClass<-droplevels(TrainFact$MSSubClass,exclude='1-1/2 STORY PUD - ALL AGES')
kable(table(TrainFact$MSSubClass))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
1-STORY 1946 & NEWER ALL STYLES 536
1-STORY 1945 & OLDER 69
1-STORY W/FINISHED ATTIC ALL AGES 4
1-1/2 STORY - UNFINISHED ALL AGES 12
1-1/2 STORY FINISHED ALL AGES 144
2-STORY 1946 & NEWER 299
2-STORY 1945 & OLDER 60
2-1/2 STORY ALL AGES 16
SPLIT OR MULTI-LEVEL 58
SPLIT FOYER 20
DUPLEX - ALL STYLES AND AGES 52
1-STORY PUD (Planned Unit Development) - 1946 & NEWER 87
2-STORY PUD - 1946 & NEWER 63
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 10
2 FAMILY CONVERSION - ALL STYLES AND AGES 30



Podemos ver que ya no figura



Realizamos la misma operación que con el vecindario, solo que aquí tenemos 16 (15 con la que no tratamos transitoriamente) grupos por lo que los cluster van de 3 a 8

Los resultados los presento juntas las cuatro variables

Aqui solo aparecen los dendogramas

#Preparacion
Resultados.clases<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos 
train.prueba<-TrainFact%>%group_by(MSSubClass)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$MSSubClass
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Clase',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Clase',cutree(train.hcl,k=4))
train.dat[,4]<-paste0('Clase',cutree(train.hcl,k=5))
train.dat[,5]<-paste0('Clase',cutree(train.hcl,k=6))
train.dat[,6]<-paste0('Clase',cutree(train.hcl,k=7))
train.dat[,7]<-paste0('Clase',cutree(train.hcl,k=8))

#Se crean nuevas columnas con los clusters calculados
TrainFact$MSSubClassMean1<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean1)<- train.dat[,2]
TrainFact$MSSubClassMean2<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean2)<- train.dat[,3]
TrainFact$MSSubClassMean3<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean3)<- train.dat[,4]
TrainFact$MSSubClassMean4<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean4)<- train.dat[,5]
TrainFact$MSSubClassMean5<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean5)<- train.dat[,6]
TrainFact$MSSubClassMean6<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean6)<- train.dat[,7]

#Prueba clusterizacion medianas
#Obtencion de los datos 
train.prueba3<-TrainFact%>%group_by(MSSubClass)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$MSSubClass
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Clase', cutree(train.hcl2,k=3))
train.dat2[,3]<-paste0('Clase',cutree(train.hcl2,k=4))
train.dat2[,4]<-paste0('Clase',cutree(train.hcl2,k=5))
train.dat2[,5]<-paste0('Clase',cutree(train.hcl2,k=6))
train.dat2[,6]<-paste0('Clase',cutree(train.hcl2,k=7))
train.dat2[,7]<-paste0('Clase',cutree(train.hcl2,k=8))

#Se crean nuevas columnas con los clusters calculados
TrainFact$MSSubClassMedian1<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian1)<- train.dat2[,2]
TrainFact$MSSubClassMedian2<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian2)<- train.dat2[,3]
TrainFact$MSSubClassMedian3<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian3)<- train.dat2[,4]
TrainFact$MSSubClassMedian4<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian4)<- train.dat2[,5]
TrainFact$MSSubClassMedian5<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian5)<- train.dat2[,6]
TrainFact$MSSubClassMedian6<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian6)<- train.dat2[,7]

#Presentacion resultados
Resultados.clases<-cbind(c(3,4,5,6,7,8,'Todos'))
Resultados.clases<-cbind(Resultados.clases,c(condes(TrainFact%>%select(Id,MSSubClassMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClass,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.clases<-cbind(Resultados.clases,c(condes(TrainFact%>%select(Id,MSSubClassMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClass,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.clases<-as.data.frame(Resultados.clases)
colnames(Resultados.clases)<-c('Numero clusters','R2 Media','R2 Mediana')



1.5.4.5 CONCLUSIONES



He obtenido en las siguientes tablas los coeficientes de determinación las variables agrupadas en diferentes clusters.

Tambien figura el valor del que partíamos

#Añado la diferencia en columna
options(digits=8)

Resultados.cimientos$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.cimientos$`R2 Media`))[Resultados.cimientos$`R2 Media`]-as.numeric(levels(Resultados.cimientos$`R2 Mediana`))[Resultados.cimientos$`R2 Mediana`])
Resultados.clases$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.clases$`R2 Media`))[Resultados.clases$`R2 Media`]-as.numeric(levels(Resultados.clases$`R2 Mediana`))[Resultados.clases$`R2 Mediana`])
Resultados.garage$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.garage$`R2 Media`))[Resultados.garage$`R2 Media`]-as.numeric(levels(Resultados.garage$`R2 Mediana`))[Resultados.garage$`R2 Mediana`])
Resultados.vecinos$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.vecinos$`R2 Media`))[Resultados.vecinos$`R2 Media`]-as.numeric(levels(Resultados.vecinos$`R2 Mediana`))[Resultados.vecinos$`R2 Mediana`])



La idea es optimizar el numero que nos quedaremos teniendo en cuenta que ya tenemos 11 variables numéricas

Lo primero mas destacable que se observa es que no hay diferencias tomando la media o la mediana de los precios en la variable GarageType.

Esto se explica porque el dendograma es idéntico en ambos supuestos. Aqui se puede ver

Lo segundo que destaca es que en la gran mayoría de los supuestos tomar como referencia la media del precio suele ser mejor que hacerlo con la mediana. La diferencia es positiva en la mayoría de los casos.

Como criterios:

  • En primer lugar seguir el orden asignado por el coeficiente de determinación general. Tendran preferencias las categorías de Neighborhood, sobre el resto, luego Foundation, GarageType y por ultimo MSSubClass

  • Luego elegir aquel agrupamiento en que el paso a un numero de cluster menor suponga una diferencia muy superior a la que supuso el paso anterior (de un numero de clusters mayor) Vemos todo en una tabla con una vista mas amigable

kable(Resultados.vecinos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(2,background = 'yellow')%>%row_spec(3,background = 'lawngreen')
Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
3 0.510288922673946 0.510288922673946 0
4 0.520752826029343 0.519728064432752 0.00102476159659104
5 0.534661463050312 0.533467614063988 0.00119384898632402
6 0.536798653780542 0.533811092372337 0.002987561408205
7 0.541121980460839 0.539159180649222 0.00196279981161707
8 0.542448822452204 0.54101354304445 0.00143527940775401
Todos 0.545574990809563 0.545574990809563 0

kable(Resultados.cimientos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange1')%>%row_spec(3,background = 'yellow')%>%row_spec(4,background = 'lawngreen')
Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
2 0.0568254698693131 0.247754678851469 -0.190929208982156
3 0.254395725745173 0.248262307945321 0.00613341779985199
4 0.2548092461983 0.252170668995711 0.00263857720258898
5 0.256199967397587 0.255658927697032 0.000541039700554968
Todos 0.256368401530415 0.256368401530415 0

kable(Resultados.garage)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(2,background = 'orange1')%>%row_spec(3,background = 'lawngreen')
Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
2 0.216280939876281 0.216280939876281 0
3 0.224281569646271 0.224281569646271 0
4 0.247622864331931 0.247622864331931 0
5 0.249122673737389 0.249122673737389 0
Todos 0.249204230504291 0.249204230504291 0

kable(Resultados.clases)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange1')%>%row_spec(3,background = 'yellow')%>%row_spec(4,background = 'lawngreen')
Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
3 0.174786074913226 0.188741697652476 -0.01395562273925
4 0.235584333942853 0.230629760361157 0.00495457358169599
5 0.239410301887266 0.241858637138703 -0.00244833525143701
6 0.243776881430928 0.241878911205326 0.00189797022560198
7 0.245698829986421 0.241915556005449 0.003783273980972
8 0.24576269922555 0.242459440131863 0.00330325909368701
Todos 0.246315972817565 0.246315972817565 0



Hemos descartado trabajar con la mediana.

Descartamos primero aquellas con un coeficiente muy bajo. Las tacho en naranja. Ese es el minimo

Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar

Tenemos que la primera elección es :

  • Vecinos: 5 clusters sobre 25 categorias Correlacion ~0.7312
  • Cimientos 5 clusters sobre 6 categorias Correlacion ~0.5061
  • Garaje 4 clusters sobre 7 categorias Correlacion~0.4976
  • Clases 6 clusters sobre 16 categorias Correlacion ~0.4937

Son un total de 20 categorias.

En las dos ultimas (Garage y Clases ) parece difícil reducir mas sin que haya una perdida importante, y ya están muy al limite.

Quizas podríamos reducir uno o dos mas en Cimientos, pero la cantidad de 31 variables numéricas , entre las originales y las reconvertidas puede ser una buena cifra

Para realizar la actualización recuperamos parte del código con el numero cluster que hemos decidido

#Escojo los agrupamientos
#Vecinos 5 clusters
train.prueba<-TrainFact%>%group_by(Neighborhood)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Neighborhood
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Barrio',cutree(train.hcl,k=5))
TotalFact$NeighborhoodMean4<-TotalFact$Neighborhood
levels(TotalFact$NeighborhoodMean4)<- train.dat[,2]
total$Vecindario<-TotalFact$NeighborhoodMean4

#Cimientos 5 clusters
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimientos',cutree(train.hcl,k=5))
TotalFact$FoundationMean4<-TotalFact$Foundation
levels(TotalFact$FoundationMean4)<- train.dat[,2]
total$Cimientos<-TotalFact$FoundationMean4

#Garage 4 clusters
train.prueba<-TrainFact%>%group_by(GarageType)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$GarageType
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Garage',cutree(train.hcl,k=4))
TotalFact$GarageTypeMean3<-TotalFact$GarageType
levels(TotalFact$GarageTypeMean3)<- train.dat[,2]
total$UbicaGarage<-TotalFact$GarageTypeMean3



Para el caso de la variable MSSubClass tenemos que recordar que para hacer la agrupación teníamos una categoría que se encontraba en el dataset Test pero no en el Train, luego dejamos esa categoría apartada , pero ahora hay que introducirla manualmente en un cluster.

Para encontrar en que cluster voy a buscar registros con ciertas variables muy correlacionadas con el objetivo y que se parezcan a las del que buscamos.

Voy a usar las variables numéricas Habitat, AreaPiso y OverallQual

Primero identificamos el registro

#Clases 6 clusters
#TrainFact$MSSubClassMean4
#Busqueda
kable(total%>%filter(MSSubClass=='1-1/2 STORY PUD - ALL AGES')%>%select(Id,AreaPiso,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id AreaPiso Habitat OverallQual
2819 0.09323653 0.17182298 0.66666667

A continuacion escogemos las ventanas de los parametros para el filtrado

0.06<AreaPiso<0.12

0.16<Habitat<0.18

0.6<OverallQual<0.7

Filtramos por aproximacion a estas variables

prue<-total%>%filter(OverallQual>0.6 & OverallQual<0.7)%>%select(Id,AreaPiso,Habitat,MSSubClass)
prue<-prue%>%filter(AreaPiso>0.06 & AreaPiso<0.12)
prue<-prue%>%filter(Habitat>0.16 & Habitat<0.18)%>%select(Id,MSSubClass)
kable(table(prue$MSSubClass))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Var1 Freq
1-STORY 1946 & NEWER ALL STYLES 0
1-STORY 1945 & OLDER 0
1-STORY W/FINISHED ATTIC ALL AGES 0
1-1/2 STORY - UNFINISHED ALL AGES 0
1-1/2 STORY FINISHED ALL AGES 0
2-STORY 1946 & NEWER 9
2-STORY 1945 & OLDER 0
2-1/2 STORY ALL AGES 0
SPLIT OR MULTI-LEVEL 1
SPLIT FOYER 0
DUPLEX - ALL STYLES AND AGES 0
1-STORY PUD (Planned Unit Development) - 1946 & NEWER 0
1-1/2 STORY PUD - ALL AGES 1
2-STORY PUD - 1946 & NEWER 0
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER 0
2 FAMILY CONVERSION - ALL STYLES AND AGES 0



Hay 11 registros con campos parecidos, incluido el que buscamos.

La gran mayoría 9 tienen en MSSubClass 2-STORY 1946 & NEWER.

Donde esté esta categoría agrupada pondremos la que nos falta

#Modificacion
train.prueba<-TrainFact%>%group_by(MSSubClass)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$MSSubClass
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Clase',cutree(train.hcl,k=6))
TotalFact$MSSubClassMean4<-TotalFact$MSSubClass



Hasta aquí es todo igual.

Vamos a buscar en que grupo queda 2-STORY 1946 & NEWER que es donde hay que meter el nivel de factor que nos falta

#Vemos el que falta y se añade
kable(train.dat)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
train.dat V2
1-STORY 1946 & NEWER ALL STYLES Clase1
1-STORY 1945 & OLDER Clase2
1-STORY W/FINISHED ATTIC ALL AGES Clase3
1-1/2 STORY - UNFINISHED ALL AGES Clase2
1-1/2 STORY FINISHED ALL AGES Clase3
2-STORY 1946 & NEWER Clase4
2-STORY 1945 & OLDER Clase5
2-1/2 STORY ALL AGES Clase1
SPLIT OR MULTI-LEVEL Clase5
SPLIT FOYER Clase3
DUPLEX - ALL STYLES AND AGES Clase6
1-STORY PUD (Planned Unit Development) - 1946 & NEWER Clase1
2-STORY PUD - 1946 & NEWER Clase6
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER Clase2
2 FAMILY CONVERSION - ALL STYLES AND AGES Clase6



Es el elemento numero 9 que corresponde a Clase4

Ademas

levels(total$MSSubClass)
##  [1] "1-STORY 1946 & NEWER ALL STYLES"                      
##  [2] "1-STORY 1945 & OLDER"                                 
##  [3] "1-STORY W/FINISHED ATTIC ALL AGES"                    
##  [4] "1-1/2 STORY - UNFINISHED ALL AGES"                    
##  [5] "1-1/2 STORY FINISHED ALL AGES"                        
##  [6] "2-STORY 1946 & NEWER"                                 
##  [7] "2-STORY 1945 & OLDER"                                 
##  [8] "2-1/2 STORY ALL AGES"                                 
##  [9] "SPLIT OR MULTI-LEVEL"                                 
## [10] "SPLIT FOYER"                                          
## [11] "DUPLEX - ALL STYLES AND AGES"                         
## [12] "1-STORY PUD (Planned Unit Development) - 1946 & NEWER"
## [13] "1-1/2 STORY PUD - ALL AGES"                           
## [14] "2-STORY PUD - 1946 & NEWER"                           
## [15] "PUD - MULTILEVEL - INCL SPLIT LEV/FOYER"              
## [16] "2 FAMILY CONVERSION - ALL STYLES AND AGES"



Tiene que ir en la posicion numero 13.

La añadiremos como una fila a train.dat desplazando el resto

#Añado el level
levels(train.dat$train.dat)<-c(levels(train.dat$train.dat),'1-1/2 STORY PUD - ALL AGES')
#Añado la fila
train.dat<-rbind(train.dat,c('1-1/2 STORY PUD - ALL AGES','Clase4'))
#Cojo levels originales como vector
lev<-as.vector(levels(total$MSSubClass))
#Comparo y ordeno
train.dat<-train.dat[match(lev,train.dat$train.dat),]

#Ya estan ordenados los level y los valores que les sutituyen
levels(TotalFact$MSSubClassMean4)<-train.dat$V2
total$Clases<-TotalFact$MSSubClassMean4



2 MODELIZACION



Para buscar el modelo que mas conviene tomar para realizar la prediccion que se pide voy a dividir el conjunto de predictores en varias partes.

Por un lado aquellos predictores que son desde el origen numéricos y que además son continuos o discretos con un numero amplio de intervalos

Son :Antiguedad, AntGarage, AreaPiso, GarageTotal, Habitat y OverallQual

En otro grupo los predictores numéricos de origen ordinal con un numero pequeño de intevalos.

Son : BsmtQual, ExterQual, FireplaceQu, GarageFinish y KitchenQual

En el ultimo grupo los predictores de origen categoricos

Son : Neighborhood, Foundation, GarageType y MSSubClass

Esta división solo la hago en sentido grafico para apreciar mejor las diversas características

Voy a aplicar un modelo lineal multiple, uno polinómico, otro suavizado tipo Loess y uno suavizado con curvas Spline y vamos a comparar en cada variable con respecto a la objetivo SalePrice

Aunque el grafico es muy completo entre toda las variables solos nos interesa la fila inferior donde aparecen los graficos de cada predictor en función del objetivo

Podemos ver también en las primeras graficas en la columna mas a la derecha el valor de correlacion de SalePrice con el resto de variables



2.1 NUMERICAS Continuas y discreta con muchas agrupaciones



Primero una vision de conjunto

#preparacion datos
Model1<-total%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual,SalePrice)
ModelTrain1<-Model1%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)


GGP1<-ggpairs(ModelTrain1, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")
GGP1<-GGP1+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP1


GGP2<-ggpairs(ModelTrain1, lower = list(continuous = my_rg2), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Purpura y Modelo lineal polinomico (poly)-Naranja")
GGP2<-GGP2+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP2


GGP3<-ggpairs(ModelTrain1, lower = list(continuous = my_rg3), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Verde y Suavizado Local(Loess)-Rojo")
GGP3<-GGP3+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP3



Vemos ahora en detalle


#Plots individuales
p11<-getPlot(GGP1,7,1)
p12<-getPlot(GGP1,7,2)
p13<-getPlot(GGP1,7,3)
p14<-getPlot(GGP1,7,4)
p15<-getPlot(GGP1,7,5)
p16<-getPlot(GGP1,7,6)
p31<-getPlot(GGP3,7,1)
p36<-getPlot(GGP3,7,6)


p11<-p11+labs(title="Antiguedad")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p12<-p12+labs(title="AntGarage")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p13<-p13+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p14<-p14+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p15<-p15+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p16<-p16+labs(title="OverallQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p31<-p31+labs(title="Antiguedad")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p36<-p36+labs(title="OverallQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p11

Antigüedad: Se adapta mejor la curva suavizada que la recta

p12

AntGarage: la especificidad de los datos (como poner antigüedad a los que no tienen garaje) hace que salga una grafica extraña, pero me decanto por el modelo lineal

p13

AreaPiso: los outliers hacen que las curvas no sirvan

p14

GarageTotal: Es el mismo caso que el anterior

p15

Habitat: Es el mismo caso que el anterior

p16

OverallQual: Pasa algo parecido que con la antigüedad. Se adapta mejor una curva



Vemos las dos variables que se adaptan mejor a las curvas en comparativa de Loess y B Spline

p31

p36



Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente



2.2 NUMERICAS discretas (resto)



Primero una vision de conjunto


#Preparacion de datos
Model2<-total%>%select(Id,BsmtQual,ExterQual,FireplaceQu,GarageFinish,KitchenQual,SalePrice)
ModelTrain2<-Model2%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)


GGP4<-ggpairs(ModelTrain2, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")
GGP4<-GGP4+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP4

GGP5<-ggpairs(ModelTrain2, lower = list(continuous = my_rg2), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Purpura y Modelo lineal polinomico (poly)-Naranja")
GGP5<-GGP5+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP5

GGP6<-ggpairs(ModelTrain2, lower = list(continuous = my_rg4), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo lineal con intervalo de confianza - Purpura")
GGP6<-GGP6+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP6

De las tres grafica la mas interesante es esta ultima. En la primera nos queda claro que un ajuste de regresión local con Loess no sirve, salvo quizás en FireplaceQu


Veamos ahora una por una como se adaptan mejor si a un modelo lineal o suavizado con B Splines

#Plots individuales
p51<-getPlot(GGP5,6,1)
p52<-getPlot(GGP5,6,2)
p53<-getPlot(GGP5,6,3)
p54<-getPlot(GGP5,6,4)
p55<-getPlot(GGP5,6,5)

p51<-p51+labs(title="BsmtQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p52<-p52+labs(title="ExterQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p53<-p53+labs(title="FireplaceQu")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p54<-p54+labs(title="GarageFinish")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p55<-p55+labs(title="KitchenQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p51

p52

p53

p54

p55

A la hora de comparar entre el modelo lineal (línea purpura) y las curvas suavizadas B Splines vemos que todas quedan mejor explicadas por la B Spline salvo FireplaceQu pero esta solo se verá numericamente



2.3 CATEGORICAS



En cuanto al resto de variables categoricas , no se puede hacer ningún análisis grafico por la propia composición de la variable.

Si podemos ver una matriz de graficos de sus variables origen ordenadas por la variable destino

#preparacion
Model3<-total%>%select(Id,Neighborhood,Foundation,GarageType,MSSubClass,SalePrice)
ModelTrain3<-Model3%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)

ModelTrain3$Neighborhood<-reorder(ModelTrain3$Neighborhood,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$Foundation<-reorder(ModelTrain3$Foundation,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$GarageType<-reorder(ModelTrain3$GarageType,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$MSSubClass<-reorder(ModelTrain3$MSSubClass,ModelTrain3$SalePrice,FUN = 'mean')

GGP7<-ggpairs(ModelTrain3, lower = list(combo = 'box'), diag = list(continuous = "densityDiag"), axisLabels = "none",cardinality_threshold = 25,title='Variables Categoricas')
GGP7<-GGP7+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP7

GGP8<-ggpairs(ModelTrain3, lower = list(combo = 'dot'), diag = list(continuous = "densityDiag",discrete='barDiag'), axisLabels = "none",cardinality_threshold = 25,title='Variables Categoricas')
GGP8<-GGP8+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP8



Si vemos en detalle las graficas

#Plots individuales
p81<-getPlot(GGP8,5,1)
p82<-getPlot(GGP8,5,2)
p83<-getPlot(GGP8,5,3)
p84<-getPlot(GGP8,5,4)

p81<-p81+labs(title="Neighborhood")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p82<-p82+labs(title="Foundation")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p83<-p83+labs(title="GarageType")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p84<-p84+labs(title="MSSubClass")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p81

p82

p83

p84

Vemos que se puede apreciar cierta linealidad



Si vemos ahora con la agrupación de clusters y ordenadas

#DUMMYS
#preparacion
Model4<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases,SalePrice)
ModelTrain4<-Model4%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)

ModelTrain4$Vecindario<-reorder(ModelTrain4$Vecindario,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$Cimientos<-reorder(ModelTrain4$Cimientos,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$UbicaGarage<-reorder(ModelTrain4$UbicaGarage,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$Clases<-reorder(ModelTrain4$Clases,ModelTrain4$SalePrice,FUN = 'mean')


GGP9<-ggpairs(ModelTrain4, lower = list(combo='dot'), diag = list(continuous = "densityDiag"), axisLabels = "none")
GGP9<-GGP9+theme(plot.title = element_text(color='darkorange',hjust=.3,size=42,lineheight = 1))
GGP9



#Plots individuales
p91<-getPlot(GGP9,5,1)
p92<-getPlot(GGP9,5,2)
p93<-getPlot(GGP9,5,3)
p94<-getPlot(GGP9,5,4)

p91<-p91+labs(title="Neighborhood")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p92<-p92+labs(title="Foundation")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p93<-p93+labs(title="GarageType")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p94<-p94+labs(title="MSSubClass")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))



p91

p92

p93

p94



Aquí vemos dos conclusiones importantes:

  • Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias

  • Es posible eliminar un cluster mas en Cimientos como se había apuntado, pero ahora se ve mejor



#Revision de cimientos . Reduccion de 5 clusters

#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact$Id<-total$Id
TotalFact$SalePrice<-total$SalePrice
TrainFact<-TotalFact%>%filter(is.na(SalePrice)==FALSE)

#Cimientos 3 y 4 clusters
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimientos',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Cimientos',cutree(train.hcl,k=4))
TotalFact$FoundationMean3<-TotalFact$Foundation
TotalFact$FoundationMean4<-TotalFact$Foundation
levels(TotalFact$FoundationMean3)<- train.dat[,2]
levels(TotalFact$FoundationMean4)<- train.dat[,3]

#Carga  provisional en dataset
total$Cimientos1<-TotalFact$FoundationMean3
total$Cimientos2<-TotalFact$FoundationMean4



Y aquí están los resultados para 3, 4 y 5 clusters

#Recarga de informacion
Model5<-total%>%select(Id,Cimientos1,Cimientos2,Cimientos,SalePrice)
ModelTrain5<-Model5%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)

ModelTrain5$Cimientos1<-reorder(ModelTrain5$Cimientos1,ModelTrain5$SalePrice,FUN = 'mean')
ModelTrain5$Cimientos2<-reorder(ModelTrain5$Cimientos2,ModelTrain5$SalePrice,FUN = 'mean')
ModelTrain5$Cimientos<-reorder(ModelTrain5$Cimientos,ModelTrain5$SalePrice,FUN = 'mean')

GGP10<-ggpairs(ModelTrain5, lower = list(combo='dot'), diag = list(continuous = "densityDiag"), axisLabels = "none",title='Resultados para cluster de Cimientos: 3 , 4 o 5')
GGP10<-GGP10+theme(plot.title = element_text(color='darkorange',hjust=.3,size=42,lineheight = 1))
GGP10



En detalle

p101<-getPlot(GGP10,4,1)
p102<-getPlot(GGP10,4,2)
p103<-getPlot(GGP10,4,3)

p101<-p101+labs(title="Cluster n=3")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p102<-p102+labs(title="Cluster n=4")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p103<-p103+labs(title="Cluster n=5")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))

p101

p102

p103



Graficamente la mejor opcion es n=3. Ademas vimos en la sección anterior que no había tanta diferencia

kable(Resultados.cimientos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange')%>%row_spec(2,background = 'lawngreen')
Numero clusters R2 Media R2 Mediana Diferencia_Media_Mediana
2 0.0568254698693131 0.247754678851469 -0.190929208982156
3 0.254395725745173 0.248262307945321 0.00613341779985199
4 0.2548092461983 0.252170668995711 0.00263857720258898
5 0.256199967397587 0.255658927697032 0.000541039700554968
Todos 0.256368401530415 0.256368401530415 0
#Se escoge 3 cluster
total$Cimientos<-total$Cimientos1
total$Cimientos1<-NULL
total$Cimientos2<-NULL



Se realiza la transformación de las categorías de las variables no numéricas en variables dummy

#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact1<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact1$Id<-total$Id

#Conversion a Dummys
Total.dummy.B<-TotalFact1%>%select(Id,B=Vecindario)
Total.dummy.C<-TotalFact1%>%select(Id,C=Cimientos)
Total.dummy.G<-TotalFact1%>%select(Id,G=UbicaGarage)
Total.dummy.N<-TotalFact1%>%select(Id,N=Clases)

modelo1.B<-as.data.frame(model.matrix(~.,Total.dummy.B))
modelo1.C<-as.data.frame(model.matrix(~.,Total.dummy.C))
modelo1.G<-as.data.frame(model.matrix(~.,Total.dummy.G))
modelo1.N<-as.data.frame(model.matrix(~.,Total.dummy.N))
modelo1.B$`(Intercept)`<-NULL
modelo1.C$`(Intercept)`<-NULL
modelo1.G$`(Intercept)`<-NULL
modelo1.N$`(Intercept)`<-NULL

modelo1<-modelo1.B
modelo1<-cbind(modelo1,modelo1.C%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.G%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.N%>%select(-Id))
#Modelo con dummys
Cuant<-total%>%select(Antiguedad,AntGarage,AreaPiso,BsmtQual,ExterQual,FireplaceQu,GarageFinish,GarageTotal,Habitat,KitchenQual,OverallQual,SalePrice)
modelo1.dummy<-cbind(modelo1,Cuant)
#Modelo con variables categoricas
Total.dummy<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases)
modelo1.Nodummy<-cbind(Total.dummy,Cuant)



2.4 OUTLIERS



Si recordamos encontramos dos valores outliers .

El registro 524 que tenia discordancia entre los años de construcción remodelación y venta(corregido) y además tenia un precio muy bajo para el área habitable en sotano y primer piso.

Eso mismo le pasaba al registro 1299 que tenia un precio muy bajo para el área habitable y además no tenia proporción entre el área habitable, las habitaciones y los baños

En principio tenia pensado dejarles por que además en común con estos dos teniamos el registro 2550 que tenia discordancia en los años y falta de proporción entre el área habitable, las habitaciones y los baños, y este registro esta en el Test, pero he creido mas conveniente eliminarles de los datos

Antes de eliminarlos vamos a comprobar que posición ocupan en las variables numéricas normalizadas porque si son el valor extremo, máximo o minimo , al eliminarlo deberemos volver a normalizar esa variable con el nuevo extremo

#Vemos valores de variables numericas de los outliers por si hay que volver a normalizar
kable(modelo1.Nodummy%>%slice(524)%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id Antiguedad AntGarage AreaPiso GarageTotal Habitat OverallQual
524 0 0 0.5676347 0.35645161 0.75770895 1
kable(modelo1.Nodummy%>%slice(1299)%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id Antiguedad AntGarage AreaPiso GarageTotal Habitat OverallQual
1299 0 0 1 0.3811828 0.91658963 1



Tanto Antigüedad como AntGarage ,y OverallQuall tienen varios registros con el mismo valor que el que vamos a eliminar, .

Sin embargo en AreaPiso el registro 1299 es el máximo. Cuando le eliminemos hay que normalizar de nuevo

#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=524)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1299)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)

modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=524)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1299)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)

modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)



Volvemos a cargar los graficos y comparamos

Afectaban sobre todo a AreaPiso, GarageTotal y Habitat

GGP11<-ggpairs(modelo1.Nodummy.train, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")

p131<-getPlot(GGP11,4,1)
p141<-getPlot(GGP11,4,2)
p151<-getPlot(GGP11,4,3)


p131<-p131+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p141<-p141+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p151<-p151+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))



p13

p131

p14

p141

p15

p151



Han mejorado tanto AreaPiso como Habitat

Sin embargo tenemos otros outliers que aparecen en GarageTotal

Les seleccionamos y vemos su influencia en las dos variable anteriores (puntos en rojo)

p132<-p131+geom_point(data=modelo1.Nodummy.train,aes(x=modelo1.Nodummy.train$AreaPiso,y=modelo1.Nodummy.train$SalePrice,colour=modelo1.Nodummy.train$GarageTotal>0.5 & modelo1.Nodummy.train$SalePrice<300000))+scale_colour_manual(values = c(alpha("black",0), "red"))+theme(legend.position = 'none')
p152<-p151+geom_point(data=modelo1.Nodummy.train,aes(x=modelo1.Nodummy.train$Habitat,y=modelo1.Nodummy.train$SalePrice,colour=modelo1.Nodummy.train$GarageTotal>0.5 & modelo1.Nodummy.train$SalePrice<300000))+scale_colour_manual(values = c(alpha("black",0), "red"))+theme(legend.position = 'none')
p132

p152



kable(total%>%filter(GarageTotal>0.5 & SalePrice<300000)%>%select(Id))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
Id
582
1062
1191
1351

Los eliminamos, actualizamos, normalizamos y volvemos a revisar los graficos

#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=582)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1062)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1191)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1351)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)

modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=582)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1062)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1191)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1351)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)

modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)

Volvemos a cargar los graficos y comparamos

Afectaba sobre todo a GarageTotal

GGP12<-ggpairs(modelo1.Nodummy.train, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")

p132<-getPlot(GGP12,4,1)
p142<-getPlot(GGP12,4,2)
p152<-getPlot(GGP12,4,3)


p132<-p132+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p142<-p142+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p152<-p152+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))



p131

p132

p141

p142

p151

p152

3 SELECCION Y PREDICCION



3.1 FILTRADO



Vamos a realizar un filtrado de las variables mediante el método sbf() del paquete caret

Vamos a realizarlo con dos funciones internas diferentes para poder comparar y validar los resultados , ramdom forest y modelo lineal



#FILTRADO DE VARIABLES CON CARET
#Filtrado con sbf de caret usando RandomForest y Linear Model

# Se crea una semilla para cada partición y cada repetición: el vector debe 
# tener B+1 semillas donde B = particiones * repeticiones.

ModeloTrain.Nodummy<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
set.seed(456)
particiones = 10 
repeticiones = 5
seeds <- sample.int(1000, particiones * repeticiones + 1)

# Control del filtrado Random Forest
ctrl_filtrado.rf <- sbfControl(functions = rfSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)

# Control del filtrado Linear Model
ctrl_filtrado.lm <- sbfControl(functions = lmSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)

set.seed(234) 
rf_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.rf,ntree = 500) 

lm_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.lm) 



#Vemos las variables que tenems quequedarnos
kable(rf_sbf$optVariables)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover")) #optimas variables segun Random Forest
x
VecindarioBarrio2
VecindarioBarrio3
VecindarioBarrio4
VecindarioBarrio5
CimientosCimientos2
CimientosCimientos3
UbicaGarageGarage2
UbicaGarageGarage3
UbicaGarageGarage4
ClasesClase2
ClasesClase3
ClasesClase4
ClasesClase6
Antiguedad
AntGarage
AreaPiso
BsmtQual
ExterQual
FireplaceQu
GarageFinish
GarageTotal
Habitat
KitchenQual
OverallQual
kable(lm_sbf$optVariables)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover")) #optimas variables segun Linear Model
x
VecindarioBarrio2
VecindarioBarrio3
VecindarioBarrio4
VecindarioBarrio5
CimientosCimientos2
CimientosCimientos3
UbicaGarageGarage2
UbicaGarageGarage3
UbicaGarageGarage4
ClasesClase2
ClasesClase3
ClasesClase4
ClasesClase6
Antiguedad
AntGarage
AreaPiso
BsmtQual
ExterQual
FireplaceQu
GarageFinish
GarageTotal
Habitat
KitchenQual
OverallQual



Podemos apreciar que los resultados son iguales

De las 25 variables solo se ha descartado 1

Aplicamos los resultado y eliminamos variable no influyente

Modelo2.Filtrado<-modelo1.dummy%>%select(-NClase5)
Modelo2Train.Filt<-Modelo2.Filtrado%>%filter(is.na(SalePrice)==FALSE)



3.2 MODELADO



Antes de empezar a modelizar tenemos que eliminar la variable Id de ambos dataset, pero guardando una copia para poder enviar la respuesta

#Copia seguridad y eliminacion ID
CopiaTrain<-Modelo2Train.Filt
CopiaTest<-Modelo2.Filtrado%>%filter(is.na(SalePrice)==TRUE)

TrainFinal<-CopiaTrain%>%select(-Id)
TestFinal<-CopiaTest%>%select(-Id,-SalePrice)



Para la fijación de nuesro modelo vamos a elegir el método de la validación cruzada del dataset Train con 20 iteraciones

No sabiendo que modelo elegir, para lo cual probaremos con el método train del paquete caret diversos modelos y veremos que resultados nos aportan

Una cosa interesante que aporta este metodo es que llama a los diversos metodos de distintos paquetes con diferentes hiperparametros y se encarga de seleccionar los parametros propios de cada metodo mas eficientes

#PRUEBAS MODELOS
set.seed(234)
#MultiVariate Adaptative Regression Splines
MARS<-train(TrainFinal[,-25],TrainFinal[,25],'gcvEarth',trControl = trainControl(method = 'cv',number = 20))

#Modelo lineal
LM<-train(TrainFinal[,-25],TrainFinal[,25],'lm',trControl = trainControl(method = 'cv',number = 20))

#Ramdom Forest
RF<-train(TrainFinal[,-25],TrainFinal[,25],'ranger',trControl = trainControl(method = 'cv',number = 20))         

#Modelo lineal+splines
rlm<-lm(formula = SalePrice~.,data=TrainFinal)

rnd<-lm(formula=SalePrice~bs(Antiguedad)+bs(OverallQual)+bs(BsmtQual)+bs(ExterQual)+bs(FireplaceQu)+bs(GarageFinish)+bs(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)

rnd2<-lm(formula=SalePrice~ns(Antiguedad)+ns(OverallQual)+ns(BsmtQual)+ns(ExterQual)+ns(FireplaceQu)+ns(GarageFinish)+ns(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)

#Generalized Additice Model using SPLINE
GAMS<-train(TrainFinal[,-25],TrainFinal[,25],'gamSpline',trControl = trainControl(method = 'cv',number = 20))

#Generalize Linear Models
GLM<-train(TrainFinal[,-25],TrainFinal[,25],'glm',trControl = trainControl(method = 'cv',number = 20))

#Bayesian Ridge Regression
BRR<-train(TrainFinal[,-25],TrainFinal[,25],'bridge',trControl = trainControl(method = 'cv',number = 20))

#Bayesian Ridge Regression (Model Averaged)
BLASSO<-train(TrainFinal[,-25],TrainFinal[,25],'blassoAveraged',trControl = trainControl(method = 'cv',number = 20))

#Extreme gradient boosting
XGB<-train(TrainFinal[,-25],TrainFinal[,25],'xgbLinear',trControl = trainControl(method = 'cv',number = 20))

XGBT<-train(TrainFinal[,-25],TrainFinal[,25],'xgbTree',trControl = trainControl(method = 'cv',number = 20))



3.3 RESULTADOS



Vamos a comparar los modelos elegidos

#Comprobacion resultados
options(digits=6)
model<-list(gcvEarth=MARS,lm=LM,ranger=RF,gamSpline=GAMS,glm=GLM,bridge=BRR,blassoAveraged=BLASSO,xgbLinear=XGB,xgbTree=XGBT)
result.resamples<-resamples(model)
metricas_resamples <- result.resamples$values%>%gather(key = "modelo", value = "valor", -Resample)%>%separate(col = "modelo", into = c("modelo", "metrica"), sep = "~", remove = TRUE)

#Tabla resultados

kable(metricas_resamples %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared)))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
modelo MAE RMSE Rsquared
xgbTree 17900.3 25888.2 0.891002
ranger 17796.4 26444.9 0.890143
gcvEarth 18527.0 26813.4 0.882849
gamSpline 19205.6 27160.8 0.882141
xgbLinear 19324.2 27388.8 0.881359
bridge 20573.4 29588.9 0.864643
blassoAveraged 20444.0 29604.4 0.864640
lm 20440.4 29307.8 0.863801
glm 20408.2 29537.1 0.862450
#Calculos para ponderaciones
RS<-metricas_resamples%>%filter(metrica=="Rsquared") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared))
RSM<-metricas_resamples%>%filter(metrica=="MAE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(MAE))
RSE<-metricas_resamples%>%filter(metrica=="RMSE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(RMSE))
RST<-RS%>%spread(modelo,Rsquared)
RSMT<-RSM%>%spread(modelo,MAE)
RSET<-RSE%>%spread(modelo,RMSE)



Vemos graficamente

#Grafico
graf1<-metricas_resamples %>% filter(metrica == "Rsquared") %>% group_by(modelo) %>% summarise(media = mean(valor)) %>% ggplot(aes(x = reorder(modelo, media), y = media, label = sprintf("%0.4f",round(media, 4)))) 
graf1<-graf1+ geom_segment(aes(x = reorder(modelo, media), y = 0, xend = modelo, yend = media), color = "grey50")
graf1<-graf1+ geom_point(size = 10, color = "firebrick") + geom_text(color = "white", size = 2.5) + scale_y_continuous(limits = c(0.75, 1)) 
graf1<-graf1 + labs(title = "Rsquare con CV", subtitle = "Modelos ordenados por media", x = "modelo") 
graf1<-graf1+ coord_flip() + theme_bw()
graf1
## Warning: Removed 9 rows containing missing values (geom_segment).

  
graf2<-bwplot(result.resamples,scales=list(relation="free"),xlim=list(c(13000,30000),c(18000,50000),c(0.7,1)))
graf2

Los modelos que parecen mas efectivos son RandomForest, y xgbTree

  • ranger: RandomForest es un ensamble en paralelo (bagging) de arboles de predicción en los que se selecciona aleatoriamente los predictores en cada nodo

  • xgbTree: eXtreme Gradient Boosting es un ensamble secuencial (boosting) de arboles de predicción en el que cada árbol intenta minimizar los residuos del anterior

Los otros modelos que también dan buenos resultados son:

  • GAMSpline :Generalized Additive Model using Splines es una combinacion lineal de funciones no lineales.Se trata de combinar distintos tipos de regresión en un conjunto no lineal, usando aquí smooth Splines

  • gvcEarth: MultiVariate Adaptative Regression Splines es parecido al anterior pero usando regression splines

  • XGBLinear es un un ensamble secuencial como XGBoost pero orientado hacia el modelo lineal



3.4 PREDICCION



En un data frame elijo en varias columnas las predicciones que me da cada modelo

#Calculo para distintas ponderaciones
SumaRs<-RST$ranger+RST$gamSpline+RST$xgbTree+RST$gcvEarth+RST$xgbLinear
SumaRSM<-((1/RSMT$ranger)+(1/RSMT$gamSpline)+(1/RSMT$xgbTree)+(1/RSMT$gcvEarth)+(1/RSMT$xgbLinear))
SumaRSE<-((1/RSET$ranger)+(1/RSET$gamSpline)+(1/RSET$xgbTree)+(1/RSET$gcvEarth)+(1/RSET$xgbLinear))
#Prediccion
result<-CopiaTest%>%select(-SalePrice)
result$RF<-predict(RF,TestFinal)
result$GAM<-predict(GAMS,TestFinal)
result$XGBT<-predict(XGBT,TestFinal)
result$MARS <-predict(MARS,TestFinal)
result$XGB <-predict(XGB,TestFinal)
result$media<-round(((result$RF+result$GAM+result$XGBT+result$MARS+result$XGB)/5),digits = 1)
#ponderada sobre Rsquared
result$ponderada<-round((((result$RF*RST$ranger)+(result$GAM*RST$gamSpline)+(result$XGBT*RST$xgbTree)+(result$MARS*RST$gcvEarth)+(result$XGB*RST$xgbLinear))/SumaRs),digits = 1)
#Ponderada sobre MAE
result$ponderada1<-round((((result$RF/RSMT$ranger)+(result$GAM/RSMT$gamSpline)+(result$XGBT/RSMT$xgbTree)+(result$MARS/RSMT$gcvEarth)+(result$XGB/RSMT$xgbLinear))/SumaRSM),digits = 1)
#Ponderada sobre RMSE
result$ponderada2<-round((((result$RF/RSET$ranger)+(result$GAM/RSET$gamSpline)+(result$XGBT/RSET$xgbTree)+(result$MARS/RSET$gcvEarth)+(result$XGB/RSET$xgbLinear))/SumaRSE),digits = 1)

#Redondeo hacia arriba en centenas de los valores
result$RF<-100*ceiling((result$RF/100))
result$GAM<-100*ceiling((result$GAM/100))
result$XGBT<-100*ceiling((result$XGBT/100))
result$MARS<-100*ceiling((result$MARS/100))
result$XGB<-100*ceiling((result$XGB/100))
result$media<-100*ceiling((result$media/100))
result$ponderada<-100*ceiling((result$ponderada/100))
result$ponderada1<-100*ceiling((result$ponderada1/100))
result$ponderada2<-100*ceiling((result$ponderada2/100))
Fin<-result%>%select(Id,SalePrice=media)
Fin1<-result%>%select(Id,SalePrice=RF)
Fin2<-result%>%select(Id,SalePrice=GAM)
Fin3<-result%>%select(Id,SalePrice=XGBT)
Fin4<-result%>%select(Id,SalePrice=MARS)
Fin5<-result%>%select(Id,SalePrice=XGB)
Fin6<-result%>%select(Id,SalePrice=ponderada)
Fin7<-result%>%select(Id,SalePrice=ponderada1)
Fin8<-result%>%select(Id,SalePrice=ponderada2)

write.csv(Fin,file="Ames2_house.csv",row.names = FALSE)
write.csv(Fin1,file="Ames2_house1.csv",row.names = FALSE)
write.csv(Fin2,file="Ames2_house2.csv",row.names = FALSE)
write.csv(Fin3,file="Ames2_house3.csv",row.names = FALSE)
write.csv(Fin4,file="Ames2_house4.csv",row.names = FALSE)
write.csv(Fin5,file="Ames2_house5.csv",row.names = FALSE)
write.csv(Fin6,file="Ames2_house6.csv",row.names = FALSE)
write.csv(Fin7,file="Ames2_house7.csv",row.names = FALSE)
write.csv(Fin8,file="Ames2_house8.csv",row.names = FALSE)

3.5 TEST

Estos son los resultado en Kaggle.

El valor corresponde al resultado aplicado al TEST que nos da RMSLE: Root Mean Squared Logarithmic Error similar al RMSE pero aplicando una reduccion logaritmica previa a los datos

include_graphics('Kaggle1.bmp')

Podemos apreciar que los valores son muy parecidos tanto en la media directa de los modelos escogidos como en aquella ponderacion con el criterio que sea

include_graphics('Kaggle2.bmp')

Aunque se mantiene el orden de eficiencia que habiamos obtenido de los modelos durante el entrenamiento , hay que destacar que cualquier mezcla de varios sea con el criterio que sea de ponderacion es mejor que el mejor de los modelos en solitario